· 7 years ago · Sep 18, 2018, 12:48 PM
1
2Option Explicit
3Dim rssearch As New ADODB.Recordset
4Dim rspos As New ADODB.Recordset
5Dim rspcard As New ADODB.Recordset
6Dim rsloadlist As New ADODB.Recordset
7Dim rsstocklib As New ADODB.Recordset
8Dim rsview As New ADODB.Recordset
9Dim rsprodtype As New ADODB.Recordset
10Dim rspaymentmode As New ADODB.Recordset
11Dim rscardtype As New ADODB.Recordset
12Dim rsstockinv As New ADODB.Recordset
13Dim rsstockout As New ADODB.Recordset
14Dim rsdetails As New ADODB.Recordset
15Dim rscustomer As New ADODB.Recordset
16Dim rsdiscount As New ADODB.Recordset
17Dim rslogin As New ADODB.Recordset
18Dim rsbagger As New ADODB.Recordset
19Dim strsearch, stockid, sellingprice, uom, packuom As String
20Dim tempquantityout, tempfinalprice, packstockid As String
21Dim tempfinalpayment, vatableitem, vatlessprice As String
22Dim totalvatlessprice As Double
23Dim exactamount, prodtypeid, vatableprice, vatamount As String
24Dim discamount, payableamount, suspendctr, discrate As String
25Dim posaccesslevelid, suspendini, suspendtag As String
26Dim vatexemptamt, shiftstart, shiftend, discinfoid As String
27Dim ctr, ctr1, securityprocno As Long
28Dim firstclick As Integer
29Dim billno As Double
30Dim billnoBIR As Double
31Dim bolprodtype As Boolean
32Dim sql_arr(5), arr_counter
33Dim quantityin, quantityreturned, quantitydamaged
34Dim quantitytransfer, quantitypullout, quantitysold
35Dim quantityadd, beginningbal, endingbal, quantityminus
36Dim qtysold, packqty, uomdivisor, quantityout
37
38Dim mode As tTransaction
39Dim rsloadlistcustomer As New ADODB.Recordset
40Dim rsloadtext As New ADODB.Recordset
41Dim rsstatus As New ADODB.Recordset
42Dim rsidctr As New ADODB.Recordset
43Dim customerid, customername As String
44Dim ctrcustomer
45
46Dim m_bStateCover As Boolean 'Cover open state
47Dim m_bStatePaper As Boolean 'Paper empty state
48Dim m_bCoverSensor As Boolean 'CapCoverSensor
49
50Dim rspayment As New ADODB.Recordset
51Dim rsprinter As New ADODB.Recordset
52Dim trxdate, trxtime As String
53Dim unitcost, paymentmodeid, paymentmode, buyersname As String
54Dim printerpos, printerdetails, vatdisplay As String
55Dim cardtext, coupontext, chargetext As String
56Dim printerctr As Long
57Dim b, c, d As Integer
58Dim cashamt, cardamt, couponamt, chargeamt
59Dim charges, overdue, discountamt, vatamt, payable
60Dim vatlesspayable
61Dim pcardnumber
62Dim pctypeid As String
63Dim pointsamtbase As Double
64Dim pointspesovalue As Double
65Dim prevtotalpoints As Double
66Dim prevtotalamt As Double
67'For RFID
68Dim icdev As Long
69Dim snr As Long
70Dim cardmode As Integer
71Dim dbltnxpoints As Double
72Dim dblTotalPoints As Double
73Dim discountflag As Integer
74Dim pointsflag As Integer
75Dim discminpurchase As Double
76'Dim discountinfoid As Integer
77Dim totalqty As Double
78Dim totalqty1 As Double
79Dim discamounttotal As Double
80Dim SeniorVatlessPrice As Double
81Dim rsOrderDet As New ADODB.Recordset
82Dim rsOrderDet1 As New ADODB.Recordset
83Dim rsOrderDet2 As New ADODB.Recordset
84
85Dim dblVATAmt As Double
86Dim dblVATSales As Double
87Dim dblVATExpSales As Double
88Dim dblNonVATExpSales As Double
89Dim dblDiscSales As Double
90Dim dblVATableSales As Double
91Dim strsql As String
92
93Dim strReportFlag As String
94Dim dblPercentage As Double
95
96Dim rsBIR As New ADODB.Recordset
97Dim rsSeries As New ADODB.Recordset
98Dim transacnoBIR As String
99
100
101'-------updated by haide
102Dim customerDiscountName As String
103Dim customerDiscountID As String
104
105'---for pwd discount
106Dim totalpwddiscount, totalpayable, totalvatless, totalvatlesspricewithdiscount, totaltax, totalVatable As Double
107Dim isPWD As Boolean
108Dim isSeniorCitizen As Boolean
109
110'---senior citizen vatable sales
111Dim totalSeniorCitizenVatableSales As Double
112
113Dim vatexemptsales, vatablesales As Double
114
115Private Sub cmdemergencyexit_Click()
116 LogInfo "Force Exit System"
117 End
118End Sub
119
120Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
121 LogInfo "Form Unloading - Mode " & UnloadMode
122End Sub
123
124
125
126
127Private Sub OPOSCashDrawer1_StatusUpdateEvent(ByVal Data As Long)
128 On Error GoTo LogError
129
130 Select Case Data
131 Case CASH_SUE_DRAWERCLOSED 'Drawer is closed
132 LogInfo "Cash Drawer has closed"
133 Text1.Text = "Close"
134 'Comment by RJH due to Cash Drawer Error bu success in sample prg
135 If firstload = False Then
136
137 If Text3.Text <> "Close" Then
138 Text3.Text = "Close"
139 Else
140 Call closefunction
141 End If
142
143 End If
144'-----
145 Case CASH_SUE_DRAWEROPEN 'Drawer is opened
146 LogInfo "Cash Drawer has opened"
147 Text1.Text = "Open"
148 Text3.Text = "Open"
149 firstload = False
150 'The Power Reporting Requirements fires the event when the device power status is changed.
151 Case OPOS_SUE_POWER_ONLINE ' The device is powered on.
152 LogInfo "Cash Drawer Power - Ready"
153 Text2.Text = "Ready"
154' frmposprint.Text2.Text = "Ready"
155 Case OPOS_SUE_POWER_OFF ' The device is powered off, or unconnected.
156 LogInfo "Cash Drawer Power - Off"
157 Text2.Text = "Off"
158' frmposprint.Text2.Text = "Off"
159 Case OPOS_SUE_POWER_OFFLINE ' The device is powered on, but disable to operate.
160 LogInfo "Cash Drawer Power - Not Ready"
161 Text2.Text = "Not Ready"
162' frmposprint.Text2.Text = "Not Ready"
163 Case OPOS_SUE_POWER_OFF_OFFLINE ' The device is powered off or off-line.
164 LogInfo "Cash Drawer Power - Offline"
165 Text2.Text = "Offline"
166' frmposprint.Text2.Text = "Offline"
167 Case Else
168 LogInfo "Cash Drawer Unidentified Event - " & Data
169 End Select
170
171 If boldrawer = False Then
172 If Text1.Text = "Open" Then
173 GoTo LoadError
174 ElseIf Text1.Text = "Close" Then
175 GoTo EnableControls
176 End If
177 End If
178
179 Exit Sub
180
181LoadError:
182 Frame1.Enabled = False
183 lblf10.Enabled = True
184 MsgBox "Drawer is open.", vbCritical, systemname
185 Exit Sub
186
187EnableControls:
188 Frame1.Enabled = True
189 Exit Sub
190
191LogError:
192 LogInfo "Error - " & Err.description
193 Resume Next
194
195End Sub
196
197Private Sub OPOSPOSPrinter1_StatusUpdateEvent(ByVal Data As Long)
198 'When there is a change of the status on the printer, the event is fired.
199
200 Dim bRecEnb As Boolean
201
202 'Make messages for the each event information.
203 Select Case Data
204 Case PTR_SUE_COVER_OPEN 'Printer cover is open.
205 LogInfo "Printer cover opened"
206 m_bStateCover = False
207 Case PTR_SUE_REC_EMPTY 'No receipt paper.
208 LogInfo "Printer no receit paper"
209 m_bStatePaper = False
210 Case PTR_SUE_COVER_OK 'Printer cover is close.
211 LogInfo "Printer cover closed"
212 m_bStateCover = True
213 Case PTR_SUE_REC_PAPEROK 'Receipt paper is ok.
214 LogInfo "Printer paper OK"
215 m_bStatePaper = True
216 Case PTR_SUE_REC_NEAREMPTY 'Receipt paper is ok.(Near Empty)
217 LogInfo "Printer paper near empty"
218 m_bStatePaper = True
219 Case Else
220 LogInfo "Pos Printer Unidentified Event - " & Data
221 End Select
222
223 If m_bStatePaper = True And (m_bStateCover = True Or m_bCoverSensor = False) Then
224 bRecEnb = True
225 Else
226 bRecEnb = False
227 End If
228
229 Frame1.Enabled = bRecEnb
230 lblf10.Enabled = True
231
232End Sub
233'
234'Private Sub OPOSCashDrawer1_StatusUpdateEvent(ByVal Data As Long)
235' On Error GoTo LogError
236'
237' Select Case Data
238' Case CASH_SUE_DRAWERCLOSED 'Drawer is closed
239' LogInfo "Cash Drawer has closed"
240' Text1.Text = "Close"
241' 'Comment by RJH due to Cash Drawer Error bu success in sample prg
242' If firstload = False Then
243'
244' If Text3.Text <> "Close" Then
245' Text3.Text = "Close"
246' Else
247' Call closefunction
248' End If
249'
250' End If
251''-----
252' Case CASH_SUE_DRAWEROPEN 'Drawer is opened
253' LogInfo "Cash Drawer has opened"
254' Text1.Text = "Open"
255' Text3.Text = "Open"
256' firstload = False
257' 'The Power Reporting Requirements fires the event when the device power status is changed.
258' Case OPOS_SUE_POWER_ONLINE ' The device is powered on.
259' LogInfo "Cash Drawer Power - Ready"
260' Text2.Text = "Ready"
261'' frmposprint.Text2.Text = "Ready"
262' Case OPOS_SUE_POWER_OFF ' The device is powered off, or unconnected.
263' LogInfo "Cash Drawer Power - Off"
264' Text2.Text = "Off"
265'' frmposprint.Text2.Text = "Off"
266' Case OPOS_SUE_POWER_OFFLINE ' The device is powered on, but disable to operate.
267' LogInfo "Cash Drawer Power - Not Ready"
268' Text2.Text = "Not Ready"
269'' frmposprint.Text2.Text = "Not Ready"
270' Case OPOS_SUE_POWER_OFF_OFFLINE ' The device is powered off or off-line.
271' LogInfo "Cash Drawer Power - Offline"
272' Text2.Text = "Offline"
273'' frmposprint.Text2.Text = "Offline"
274' Case Else
275' LogInfo "Cash Drawer Unidentified Event - " & Data
276' End Select
277'
278' If boldrawer = False Then
279' If Text1.Text = "Open" Then
280' GoTo LoadError
281' ElseIf Text1.Text = "Close" Then
282' GoTo EnableControls
283' End If
284' End If
285'
286' Exit Sub
287'
288'LoadError:
289' Frame1.Enabled = False
290' lblf10.Enabled = True
291' MsgBox "Drawer is open.", vbCritical, systemname
292' Exit Sub
293'
294'EnableControls:
295' Frame1.Enabled = True
296' Exit Sub
297'
298'LogError:
299' LogInfo "Error - " & Err.description
300' Resume Next
301'End Sub
302
303
304
305
306
307Private Sub Text3_Change()
308 If Text3.Text = "Close" Then
309 Call closefunction
310 End If
311End Sub
312
313Sub releaseprinter()
314 With OPOSPOSPrinter1
315 .DeviceEnabled = False
316 .ReleaseDevice
317 .Close
318 End With
319End Sub
320
321Sub initprinter()
322
323 With OPOSPOSPrinter1
324
325 .Open "Unit1"
326
327 If .ResultCode <> OPOS_SUCCESS Then
328 MsgBox "POS Printer Error." _
329 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
330 GoTo LoadErrorPrinter
331 End If
332
333 .ClaimDevice 1000
334
335 If .ResultCode <> OPOS_SUCCESS Then
336 MsgBox "POS Printer Error." _
337 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
338 GoTo LoadErrorPrinter
339 End If
340
341 .DeviceEnabled = True
342
343 If .ResultCode <> OPOS_SUCCESS Then
344 MsgBox "POS Printer Error." _
345 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
346 GoTo LoadErrorPrinter
347 End If
348
349 End With
350 Exit Sub
351
352LoadErrorPrinter:
353 MsgBox "Please Try to Reprint Bill after Transaction.", vbCritical, systemname
354
355End Sub
356
357Sub releasedrawer()
358 With OPOSCashDrawer1
359 .DeviceEnabled = False
360 .ReleaseDevice
361 .Close
362 End With
363End Sub
364
365Sub EnableCashDrawer()
366 With OPOSCashDrawer1
367 .Open "Unit1"
368 .ClaimDevice 1000
369 ' If support the CapPowerReporting, enable the Power Reporting Requirements.
370 If .CapPowerReporting <> OPOS_PR_NONE Then
371 .PowerNotify = OPOS_PN_ENABLED
372 End If
373
374 .DeviceEnabled = True
375
376 .OpenDrawer
377 End With
378End Sub
379
380Private Sub Form_Activate()
381 If bolpos = True Then
382 bolpos = False
383 Exit Sub
384 End If
385 bolprodtype = True
386 Call loadview
387 bolprodtype = False
388End Sub
389
390Private Sub Form_Unload(Cancel As Integer)
391 Call releasedrawer
392 Call releaseprinter
393 'For RFID
394 mainform.Timer3.Enabled = False
395
396' removed, moved to main form
397 LogInfo "Pos Form has unloaded"
398' Close #LogRef
399End Sub
400
401Private Sub Form_Load()
402 frmpos.Top = 725
403 frmpos.Left = 180
404 frmpos.Caption = systemname
405 totalSeniorCitizenVatableSales = 0
406 customerDiscountName = ""
407 customerDiscountID = ""
408 lblmove.Visible = True
409 lblaction.Visible = False
410 lblaction.Caption = ""
411 txtaction.Visible = False
412 frachoose.Visible = True
413 lblf10.Visible = True
414 frapayment.Visible = False
415 frarecall.Visible = False
416 txtaction.Locked = True
417 frasearch.Enabled = False
418 fraview.Enabled = False
419 'fraPCard.Enabled = False
420 totalqty = 0
421 totalqty1 = 0
422 txtTotalQty.Text = "0"
423
424 fracustomer.Visible = False
425 fraquantity.Visible = False
426 fradiscount.Visible = False
427 frapassword.Visible = False
428 fradrawer.Visible = False
429 Call cleartext
430 Call vieworderlist
431 Call loadbagger
432 cbobagger.BoundText = baggerid
433
434 ' 'removed, moved to main form
435 ' 'Tony Jimenez inclusion
436 ' '---
437 ' LogRef = FreeFile
438 ' Open App.Path & "\sys.log" For Append As #LogRef
439 LogInfo "Form POS has loaded"
440 ' '----
441
442 bolpos = False
443 'Set OPOSPOSPrinter2 = OPOSPOSPrinter1
444
445 With OPOSPOSPrinter1
446 .Open "Unit1"
447 If .ResultCode <> OPOS_SUCCESS Then
448 MsgBox "POS Printer Error." _
449 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
450 GoTo LoadErrorPrinter
451 Exit Sub
452 End If
453
454 .ClaimDevice 1000
455
456 If .ResultCode <> OPOS_SUCCESS Then
457 MsgBox "POS Printer Error." _
458 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
459 'GoTo LoadErrorPrinter
460 End If
461
462 .DeviceEnabled = True
463
464 If .ResultCode <> OPOS_SUCCESS Then
465 MsgBox "POS Printer Error." _
466 & vbCrLf & "Please check POS Printer status.", vbCritical, systemname
467 GoTo LoadErrorPrinter
468 Exit Sub
469 End If
470
471 m_bStateCover = True
472 m_bStatePaper = True
473 m_bCoverSensor = .CapCoverSensor
474
475 End With
476
477
478 Text1.Text = "Close"
479 Text2.Text = "Ready"
480
481
482'Comment by RJH
483 With OPOSCashDrawer1
484 .Open "Unit1"
485
486 If .ResultCode <> OPOS_SUCCESS Then
487 MsgBox "Cash Drawer Error." _
488 & vbCrLf & "Please check Cash Drawer status.", vbCritical, systemname
489 'GoTo LoadError
490 End If
491
492 .ClaimDevice 1000
493
494 If .ResultCode <> OPOS_SUCCESS Then
495 MsgBox "Cash Drawer Error." _
496 & vbCrLf & "Please check Cash Drawer status.", vbCritical, systemname
497 GoTo LoadError
498 End If
499
500 If .CapPowerReporting <> OPOS_PR_NONE Then
501 .PowerNotify = OPOS_PN_ENABLED
502 End If
503
504 .DeviceEnabled = True
505
506 If .ResultCode <> OPOS_SUCCESS Then
507 MsgBox "Cash Drawer Error." _
508 & vbCrLf & "Please check Cash Drawer status.", vbCritical, systemname
509 GoTo LoadError
510 End If
511End With
512'----------------
513
514
515
516 'For RFID
517 '--- Remove Activation of Timer3 upon form load by RHV 03/13/2012
518 ' If InitRF = True Then
519 ' mainform.Timer3.Enabled = True
520 ' Else
521 ' mainform.Timer3.Enabled = False
522 ' MsgBox "Card Reader Facility is disabled, pls. restart application and Card Reader !", vbInformation + vbOKOnly, systemname
523 ' End If
524 '--- Remove Activation of Timer3 upon form load by RHV 03/13/2012
525
526 Exit Sub
527
528LoadErrorPrinter:
529 m_bStateCover = False
530 m_bStatePaper = False
531 m_bCoverSensor = False
532 Frame1.Enabled = False
533 lblf10.Enabled = True
534 MsgBox "Contact your IT Personnel.", vbCritical, systemname
535
536 Exit Sub
537
538LoadError:
539 Frame1.Enabled = False
540 lblf10.Enabled = True
541 MsgBox "Contact your IT Personnel.", vbCritical, systemname
542
543End Sub
544
545Private Sub InitRFID()
546
547 If icdev > 0 Then
548 st = dc_exit(icdev)
549 icdev = 0
550 End If
551
552 If icdev < 0 Then
553 'icdev = dc_init(CInt(Text4.Text), 115200) 'init com1£¬baud rate is 115200MHZ
554 icdev = dc_init(100, 115200) 'init com1£¬baud rate is 115200MHZ
555 End If
556
557 If icdev < 0 Then
558 'List1.AddItem ("Init port Error!")
559 MsgBox "Init port Error, pls reset RFID Reader !", vbCritical + vbOKOnly
560 Exit Sub
561 End If
562 'List1.AddItem ("Init port OK!")
563
564 st = dc_config_card(icdev, &H31) 'find 15693 card,&H31 can be exchanged by 49
565 If st <> 0 Then
566 'List1.AddItem ("config card Error!")
567 MsgBox "Config Card Error, pls reset RFID Reader !", vbCritical + vbOKOnly
568 Exit Sub
569 End If
570End Sub
571
572Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
573
574 LogInfo "Keycode = " & KeyCode & ", Shift = " & Shift
575 If frachoose.Enabled = False Then
576 Exit Sub
577 End If
578
579 If KeyCode = vbKeyF1 Then
580 LogInfo "View Items Clicked"
581 Call viewitems
582 ElseIf KeyCode = vbKeyF2 Then
583 Call editorder
584 ElseIf KeyCode = vbKeyF3 Then
585 Call deleteorder
586 ElseIf KeyCode = vbKeyF4 Then
587 'Call inputpayment
588 'If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
589 ' If CardnumberExist = False Then
590 ' MsgBox "Privilege Card Number does not exist in Master File or Inactive Privilege Card !", vbCritical + vbOKOnly
591 ' txtPCardNo.Enabled = True
592 ' txtPCardNo.SetFocus
593 ' Exit Sub
594 ' End If
595 ' lblf8_Click
596 'End If
597
598 mainform.Timer1.Enabled = False
599 mainform.Timer3.Enabled = False
600
601 LogInfo "Accepting Payment ..."
602 Dim strsql As String
603
604 If txtPCardNo.Text <> "" Then
605 If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
606 If CardnumberExist = False Then
607 MsgBox "Privilege Card Number does not exist in Master File or Inactive Privilege Card !", vbCritical + vbOKOnly
608 txtPCardNo.Enabled = True
609 txtPCardNo.SetFocus
610 Exit Sub
611 End If
612
613 strsql = "SELECT b.discminpurchase FROM tbl_M_pcardmain a inner join tbl_M_pcardtype b on " & _
614 " a.pctype = b.pctypeid WHERE a.pcardnumber = '" & txtPCardNo.Text & "' "
615
616 Call modmain.rsConnection(rspos, strsql)
617 discminpurchase = rspos!discminpurchase
618
619 If Val(Format(txtcharge.Text, "####.00")) >= discminpurchase Then
620 lblf8_Click
621 End If
622
623 End If
624 End If
625
626 Call inputpayment
627
628 'Call inputpayment
629
630 ElseIf KeyCode = vbKeyF5 Then
631 Call printbill
632 ElseIf KeyCode = vbKeyF6 Then
633 Call suspendtransac
634 ElseIf KeyCode = vbKeyF7 Then
635 LogInfo "Recall Transaction Clicked"
636 Call recalltransac
637 ElseIf KeyCode = vbKeyF8 Then
638 LogInfo "Applying Discount ..."
639 If txtPCardNo.Text = "" Then
640 LogInfo "Apply Discount Clicked"
641 Call applydiscount
642 Else
643 'MsgBox "With Privilege Card", vbOKOnly
644 LogInfo "Discount PCard Clicked"
645 Call DiscountPcard
646 End If
647 ElseIf KeyCode = vbKeyF9 Then
648 Call changequantity
649 ElseIf KeyCode = vbKeyF10 Then
650 LogInfo "Exit POS Clicked"
651 Call exitpos
652 ElseIf KeyCode = vbKeyEscape Then
653 LogInfo "Cancell Transaction Clicked"
654 Call canceltransac
655 End If
656End Sub
657
658Private Sub lblf1_Click()
659 LogInfo "View Items Clicked"
660 Call viewitems
661End Sub
662
663Private Sub lblf2_Click()
664 Call editorder
665End Sub
666
667Private Sub lblf3_Click()
668 Call deleteorder
669End Sub
670
671Private Sub lblf4_Click()
672 'Call inputpayment
673 '--- Added by RHV 03/13/2012
674 mainform.Timer1.Enabled = False
675 mainform.Timer3.Enabled = False
676 '--- Added by RHV 03/13/2012
677 Dim strsql As String
678
679 LogInfo "Accepting Payment ..."
680
681 If txtPCardNo.Text <> "" Then
682
683 If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
684 If CardnumberExist = False Then
685 MsgBox "Privilege Card Number does not exist in Master File or Inactive Privilege Card !", vbCritical + vbOKOnly
686 txtPCardNo.Enabled = True
687 txtPCardNo.SetFocus
688 Exit Sub
689 End If
690
691 strsql = "SELECT b.discminpurchase FROM tbl_M_pcardmain a inner join tbl_M_pcardtype b on " & _
692 " a.pctype = b.pctypeid WHERE a.pcardnumber = '" & txtPCardNo.Text & "' "
693 Call modmain.rsConnection(rspos, strsql)
694
695 'pcardnumber = rspos!pcardnumber
696 'pctypeid = rspos!pctype
697 discminpurchase = rspos!discminpurchase
698
699 If Val(Format(txtcharge.Text, "####.00")) >= discminpurchase Then
700 lblf8_Click
701 End If
702 'Else
703 ' Call inputpayment
704 'cbopaymentmode.SetFocus
705 End If
706 'Else
707 End If
708
709 Call inputpayment
710
711End Sub
712
713Private Sub lblf5_Click()
714 LogInfo "Printing Bill ..."
715 Call printbill
716
717End Sub
718
719Private Sub lblf6_Click()
720 LogInfo "Suspend Transaction ..."
721 Call suspendtransac
722End Sub
723
724Private Sub lblf7_Click()
725 LogInfo "Recall Transaction ..."
726 Call recalltransac
727End Sub
728
729Private Sub lblf8_Click()
730 LogInfo "Applying Discount ..."
731 If txtPCardNo.Text = "" Then
732 LogInfo "Apply Discount Clicked"
733 Call applydiscount
734 Else
735 'MsgBox "With Privilege Card", vbOKOnly
736 LogInfo "Discount PCard Clicked"
737 Call DiscountPcard
738
739 End If
740End Sub
741
742Private Sub lblf9_Click()
743 Call changequantity
744End Sub
745
746Private Sub lblf10_Click()
747 LogInfo "F10 Button Clicked"
748 Call exitpos
749
750End Sub
751
752Private Sub lblesc_Click()
753 LogInfo "Cancell Transaction Clicked"
754 Call canceltransac
755End Sub
756
757Private Sub txtbarcode_KeyPress(KeyAscii As Integer)
758 On Error GoTo LogError
759
760 LogInfo "Keypressed: " & KeyAscii
761
762 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
763 '--Pls. uncomment this.. for testing only...
764 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
765 Exit Sub
766 End If
767
768 If KeyAscii = 13 Then
769 If txtbarcode.Text = "" Then
770 Exit Sub
771 End If
772 '---Added by RHV 03/12/2012
773 LogInfo "Received Barcode Scan: " & txtbarcode.Text
774 '---Added by RHV 03/12/2012
775
776 arr_counter = 0
777 strsearch = "SELECT * FROM vw_stocklist WHERE statusid = 1"
778 If Len(Trim(txtbarcode.Text)) <> 0 Then
779 arr_counter = arr_counter + 1
780 sql_arr(arr_counter) = " AND stockcode = '" & txtbarcode.Text & "'"
781 End If
782 For ctr = 1 To arr_counter
783 strsearch = strsearch & sql_arr(ctr)
784 Next
785 strsearch = strsearch & " ORDER BY stockdesc"
786
787 '---Added by RHV 03/12/2012
788 LogInfo "Searchstring done: " & strsearch & ". Now opening connection to server"
789 '---Added by RHV 03/12/2012
790
791 Set rssearch = New ADODB.Recordset
792 rssearch.CursorLocation = adUseClient
793 rssearch.Open strsearch, conn, adOpenDynamic, adLockReadOnly, adCmdText
794 If rssearch.EOF Then
795 If txtbarcode.Text = "" Then
796 LogInfo "Stockcode not found and barcode text is empty"
797 Else
798 LogInfo "Stockcode " & txtbarcode.Text & " not found"
799 MsgBox "No records found. Please update Stock Library", vbInformation, systemname
800 rssearch.Close
801 txtbarcode.Text = ""
802 End If
803 Else
804 stockid = rssearch!stockid
805 sellingprice = rssearch!sellingprice
806 uom = UCase(rssearch!uom)
807 vatableitem = rssearch!vatableitem
808 rssearch.Close
809
810 '---Added by RHV 03/12/2012
811 LogInfo "Record found. StockID:" & stockid & ".. closing database connection"
812 '---Added by RHV 03/12/2012
813
814 If lvworder.ListItems.Count = 0 Then
815 LogInfo "Executing Generate Bill No"
816 Call generatebillno
817 End If
818
819 LogInfo "Querrying DB tbl_T_orderdetail"
820 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
821 & "WHERE transacno = '" & tempbillno & "' " _
822 & "AND stockid = '" & stockid & "' " _
823 & "AND uom = '" & uom & "'")
824
825 If rspos.EOF = True Then
826 rspos.Close
827
828 tempquantityout = Val(txtquantity.Text)
829 tempfinalprice = Val(sellingprice) * Val(tempquantityout)
830
831 '---Added by RHV 03/12/2012
832 LogInfo "Inserting record to rspos"
833 '---Added by RHV 03/12/2012
834
835
836 conn.Execute "INSERT INTO tbl_T_orderdetail(transacno,stockid,datetimetrx," _
837 & "sellingprice,quantityout,finalprice,userid,lupdatetime,updatests," _
838 & "temporder,uom,vatableitem) VALUES('" & tempbillno & "','" & stockid _
839 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
840 & "','" & Format(sellingprice, "###0.00") & "','" & tempquantityout _
841 & "','" & Format(tempfinalprice, "###0.00") & "','" & userloginid _
842 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
843
844
845
846 Else
847 tempquantityout = Val(rspos!quantityout) + Val(txtquantity.Text)
848 tempfinalprice = Val(rspos!sellingprice) * Val(tempquantityout)
849 rspos.Close
850
851 '---Added by RHV 03/12/2012
852 LogInfo "Updating record to rspos"
853 '---Added by RHV 03/12/2012
854
855 conn.Execute "UPDATE tbl_T_orderdetail " _
856 & "SET quantityout = '" & tempquantityout & "'," _
857 & "finalprice = '" & Format(tempfinalprice, "###0.00") & "'," _
858 & "vatableitem = '" & vatableitem & "' " _
859 & "WHERE transacno = '" & tempbillno & "' " _
860 & "AND stockid = '" & stockid & "' " _
861 & "AND uom = '" & uom & "'"
862
863 End If
864
865 LogInfo "Calling loadorders"
866 Call loadorders
867 LogInfo "Calling loadpaymentmade"
868 Call loadpaymentmade
869 LogInfo "Calling totalcountitems"
870 Call TotalCountItems
871
872 txtquantity.Text = "1"
873 txtbarcode.SetFocus
874
875 End If
876 End If
877
878 KeyAscii = usernamepassword(KeyAscii)
879
880 Exit Sub
881
882 'catch_Error:
883 '
884 'LogInfo Err.Number & " - " & Err.description
885 '
886 'LogInfo "Checking for database errors"
887 '
888 ''--- Added by RHV 03/12/2012
889 'For Each ErrLoop In conn.Errors
890 '
891 ' Dim strError(5) As String
892 ' Dim i As Integer
893 '
894 ' strError(0) = " Error Number: " & ErrLoop.Number
895 ' strError(1) = " Description: " & ErrLoop.description
896 ' strError(2) = " Source: " & ErrLoop.Source
897 ' strError(3) = " SQL State: " & ErrLoop.SQLState
898 ' strError(4) = " Native Error: " & ErrLoop.NativeError
899 '
900 ' ' Loop through the five specified properties of Error object.
901 ' i = 0
902 ' Do While i < 5
903 ' LogInfo strError(i)
904 ' i = i + 1
905 ' Loop
906 '
907 ' conn.Errors.Clear
908 'Next
909 'On Error Resume Next
910 ''--- Added by RHV 03/12/2012
911
912LogError:
913 LogInfo "Keypressed: " & KeyAscii
914 LogInfo "Error - " & Err.description
915 Resume Next
916
917End Sub
918
919Private Sub TotalCountItems()
920 On Error GoTo LogError
921
922 Dim lstcount As Integer
923 totalqty = 0
924 lstcount = lvworder.ListItems.Count
925 For ctr = 1 To lstcount
926 totalqty = totalqty + lvworder.ListItems.Item(ctr).ListSubItems(6)
927 Next ctr
928 txtTotalQty.Text = totalqty
929 totalqty = 0
930
931 Exit Sub
932
933LogError:
934 LogInfo "Error - " & Err.description
935 Resume Next
936End Sub
937
938
939
940
941Private Sub txtPCardNo_GotFocus()
942 ' Hilighttext txtPCardNo
943 ' If InitRF = True Then
944 ' mainform.Timer3.Enabled = True
945 ' Else
946 ' MsgBox "RF Card Reader is disabled, pls. reset application and RF Card Reader", vbInformation + vbOKOnly
947 ' End If
948End Sub
949
950Private Sub cmdGetRFID_Click()
951 Hilighttext txtPCardNo
952 If InitRF = True Then
953 mainform.Timer3.Enabled = True
954 Else
955 MsgBox "RF Card Reader is disabled, pls. reset application and RF Card Reader", vbInformation + vbOKOnly
956 End If
957End Sub
958
959
960Private Sub txtPCardNo_KeyPress(KeyAscii As Integer)
961 If KeyAscii = 13 Then
962 Hilighttext txtPCardNo
963 If txtPCardNo.Text = "" Then '--Or IsNumeric(txtPCardNo.Text) = False Then
964 If MsgBox("Proceed without Privilege Card ?", vbInformation + vbYesNo, systemname) = vbYes Then
965 Call txtcash_KeyPress(KeyAscii)
966 Else
967 MsgBox "Input Privilege Card Number.", vbCritical, systemname
968 txtPCardNo.Enabled = True
969 txtPCardNo.SetFocus
970 Exit Sub
971 End If
972 Else
973
974 If CardnumberExist = False Then
975 MsgBox "Privilege Card Number does not exist in Master File or Inactive Privilege Card !", vbCritical + vbOKOnly
976 txtPCardNo.Enabled = True
977 txtPCardNo.SetFocus
978 Exit Sub
979 End If
980
981 'frmImage.Show 1
982
983 If fracash.Visible = True Then
984 txtcash.SetFocus
985 txtcash.Enabled = True
986 End If
987 If fracard.Visible = True Then
988 txtcard.SetFocus
989 txtcard.Enabled = True
990 End If
991 If fracoupon.Visible = True Then
992 txtcoupon.SetFocus
993 txtcoupon.Enabled = True
994 End If
995 If fraconsumablecharge.Visible = True Then
996 txtconsumblecharge.SetFocus
997 txtconsumblecharge.Enabled = True
998 End If
999
1000 End If
1001 End If
1002End Sub
1003
1004Function CardnumberExist()
1005 Dim strsql As String
1006 CardnumberExist = False
1007 strsql = "SELECT * FROM tbl_M_pcardmain WHERE pcardnumber = '" & txtPCardNo.Text & "' and statusid = '1' "
1008
1009 Call modmain.rsConnection(rspos, strsql)
1010
1011 If Not rspos.EOF = True Then
1012 CardnumberExist = True
1013 End If
1014
1015End Function
1016
1017
1018Private Sub txtsearch_KeyPress(KeyAscii As Integer)
1019 If KeyAscii = 13 Then
1020 If txtsearch.Text = "" Then
1021 Call loadlist(False)
1022 Else
1023 Call loadlist(True)
1024 End If
1025 Else
1026 KeyAscii = entryfields(KeyAscii)
1027 End If
1028End Sub
1029
1030Private Sub cboview_Click()
1031 If bolprodtype = True Then
1032 Exit Sub
1033 End If
1034 txtbarcode.Text = ""
1035 txtsearch.Text = ""
1036 If cboview.Text = "All" Then
1037 Call loadlist(False)
1038 Else
1039 Call loadlist(True)
1040 End If
1041End Sub
1042
1043Private Sub lvwstock_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
1044 If lvwstock.Sorted And _
1045 ColumnHeader.Index - 1 = lvwstock.SortKey Then
1046 lvwstock.SortOrder = 1 - lvwstock.SortOrder
1047 Else
1048 lvwstock.SortOrder = lvwAscending
1049 lvwstock.SortKey = ColumnHeader.Index - 1
1050 End If
1051 lvwstock.Sorted = True
1052End Sub
1053
1054Private Sub lvwstock_KeyPress(KeyAscii As Integer)
1055 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
1056 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
1057 Exit Sub
1058 End If
1059
1060 If KeyAscii = 13 Then
1061 If lvworder.ListItems.Count = 0 Then
1062 Call generatebillno
1063 End If
1064
1065 Call modmain.rsConnection(rsdetails, "SELECT stockid,uom,statusid,vatableitem " _
1066 & "FROM vw_stocklist WHERE statusid = 1 " _
1067 & "AND stockid = '" & lvwstock.SelectedItem & "' " _
1068 & "AND uom = '" & UCase(lvwstock.SelectedItem.ListSubItems(3).Text) & "'")
1069 vatableitem = rsdetails!vatableitem
1070 rsdetails.Close
1071
1072 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
1073 & "WHERE transacno = '" & tempbillno & "' " _
1074 & "AND stockid = '" & lvwstock.SelectedItem & "' " _
1075 & "AND uom = '" & UCase(lvwstock.SelectedItem.ListSubItems(3).Text) & "'")
1076
1077 If rspos.EOF = True Then
1078 rspos.Close
1079
1080 tempquantityout = Val(txtquantity.Text)
1081 tempfinalprice = Val(Format(lvwstock.SelectedItem.ListSubItems(4).Text, "###0.00")) * Val(tempquantityout)
1082
1083 conn.Execute "INSERT INTO tbl_T_orderdetail(transacno,stockid,datetimetrx," _
1084 & "sellingprice,quantityout,finalprice,userid,lupdatetime,updatests," _
1085 & "temporder,uom,vatableitem) VALUES('" & tempbillno & "','" & lvwstock.SelectedItem _
1086 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1087 & "','" & Format(lvwstock.SelectedItem.ListSubItems(4).Text, "###0.00") _
1088 & "','" & tempquantityout & "','" & tempfinalprice & "','" & userloginid _
1089 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1090 & "','A','1','" & UCase(lvwstock.SelectedItem.ListSubItems(3).Text) _
1091 & "','" & vatableitem & "')"
1092
1093 Else
1094 tempquantityout = Val(rspos!quantityout) + Val(txtquantity.Text)
1095 tempfinalprice = Val(rspos!sellingprice) * Val(tempquantityout)
1096 rspos.Close
1097
1098 conn.Execute "UPDATE tbl_T_orderdetail " _
1099 & "SET quantityout = '" & tempquantityout & "'," _
1100 & "finalprice = '" & tempfinalprice & "'," _
1101 & "vatableitem = '" & vatableitem & "' " _
1102 & "WHERE transacno = '" & tempbillno & "' " _
1103 & "AND stockid = '" & lvwstock.SelectedItem & "' " _
1104 & "AND uom = '" & UCase(lvwstock.SelectedItem.ListSubItems(3).Text) & "'"
1105
1106 End If
1107
1108 Call loadorders
1109 Call loadpaymentmade
1110 Call TotalCountItems
1111
1112 txtquantity.Text = "1"
1113 txtbarcode.SetFocus
1114 End If
1115End Sub
1116
1117Private Sub lvworder_KeyPress(KeyAscii As Integer)
1118 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
1119 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
1120 Exit Sub
1121 End If
1122
1123 If KeyAscii = 13 Then
1124 If lblaction.Caption = "Select an item to edit." Then
1125 lblaction.Caption = "Quantity"
1126 txtaction.Visible = True
1127 txtaction.Locked = False
1128 txtaction.Text = lvworder.SelectedItem.ListSubItems(6).Text
1129 uom = UCase(lvworder.SelectedItem.ListSubItems(4).Text)
1130 txtaction.SetFocus
1131 End If
1132
1133 End If
1134End Sub
1135
1136Private Sub txtaction_GotFocus()
1137 Hilighttext txtaction
1138End Sub
1139
1140Private Sub txtaction_KeyPress(KeyAscii As Integer)
1141 If lblaction.Caption = "Quantity" Then
1142 txtaction.MaxLength = 5
1143 If txtaction.Text = "" Then
1144 MsgBox "Input a quantity.", vbCritical, systemname
1145 txtaction.SetFocus
1146 Exit Sub
1147 End If
1148 If KeyAscii = 45 Then
1149 KeyAscii = 0
1150 MsgBox "Invalid input.", vbCritical, systemname
1151 txtaction.SetFocus
1152 Exit Sub
1153 End If
1154 If KeyAscii = 13 Then
1155 If Val(txtaction.Text) = 0 Then
1156 MsgBox "Zero quantity is not acceptable." _
1157 & vbCrLf & "Invalid input.", vbCritical, systemname
1158 txtaction.SetFocus
1159 Exit Sub
1160 End If
1161 txtaction.MaxLength = 15
1162
1163 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
1164 & "WHERE transacno = '" & tempbillno & "' " _
1165 & "AND stockid = '" & lvworder.SelectedItem & "' " _
1166 & "AND uom = '" & uom & "'")
1167 tempfinalprice = Val(rspos!sellingprice) * Val(txtaction.Text)
1168 rspos.Close
1169
1170 conn.Execute "UPDATE tbl_T_orderdetail " _
1171 & "SET quantityout = '" & txtaction.Text & "'," _
1172 & "finalprice = '" & tempfinalprice & "' " _
1173 & "WHERE transacno = '" & tempbillno & "' " _
1174 & "AND stockid = '" & lvworder.SelectedItem & "' " _
1175 & "AND uom = '" & uom & "'"
1176
1177 Call loadorders
1178 Call loadpaymentmade
1179 Call TotalCountItems
1180
1181 txtaction.Locked = True
1182 txtbarcode.SetFocus
1183 Exit Sub
1184 End If
1185 KeyAscii = numbersonly(KeyAscii)
1186 ElseIf lblaction.Caption = "Suspension Tag" Then
1187 KeyAscii = entryfields(KeyAscii)
1188 End If
1189End Sub
1190
1191
1192Private Sub lstrecall_KeyPress(KeyAscii As Integer)
1193 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
1194 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
1195 Exit Sub
1196 End If
1197
1198 If KeyAscii = 13 Then
1199 If MsgBox("Are you sure you want to recall this transaction?", vbInformation + vbYesNo, systemname) = vbYes Then
1200
1201 Screen.MousePointer = vbHourglass
1202
1203 Call modmain.rsConnection(rsloadlist, "SELECT * FROM tbl_T_orderdetail " _
1204 & "WHERE suspensiontag = '" & lstrecall.SelectedItem & "'")
1205 tempbillno = rsloadlist!transacno
1206
1207 conn.Execute "DELETE FROM tbl_T_transacno " _
1208 & "WHERE suspendtransacno = '" & tempbillno & "' " _
1209 & "AND stationno = '" & stationno & "'"
1210
1211 lvworder.ListItems.Clear
1212
1213 For ctr = 1 To rsloadlist.RecordCount
1214
1215 stockid = rsloadlist!stockid
1216 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
1217 & "WHERE stockid = '" & stockid & "' " _
1218 & "AND uom = '" & rsloadlist!uom & "'")
1219 Set lstitem = lvworder.ListItems.Add(, , rsloadlist!stockid)
1220 lstitem.SubItems(1) = rsstocklib!stockcode
1221 lstitem.SubItems(2) = UCase(rsstocklib!stockdesc)
1222 lstitem.SubItems(3) = UCase(rsstocklib!stockshortname)
1223 rsstocklib.Close
1224 lstitem.SubItems(4) = UCase(rsloadlist!uom)
1225 lstitem.SubItems(5) = Format(rsloadlist!sellingprice, "#,##0.00")
1226 lstitem.SubItems(6) = rsloadlist!quantityout
1227 lstitem.SubItems(7) = Format(rsloadlist!finalprice, "#,##0.00")
1228
1229 rsloadlist.MoveNext
1230 Next
1231 rsloadlist.Close
1232
1233 Call modmain.rsConnection(rsloadlist, "SELECT SUM(finalprice) AS tempfinalprice " _
1234 & "FROM tbl_T_orderdetail WHERE transacno = '" & tempbillno & "'")
1235 tempfinalprice = IIf(IsNull(rsloadlist!tempfinalprice), "0", rsloadlist!tempfinalprice)
1236 rsloadlist.Close
1237
1238 Call modmain.rsConnection(rsloadlist, "SELECT transacno,discountamount,discountinfoid " _
1239 & "FROM tbl_T_chargesdiscount WHERE transacno = '" & tempbillno & "' " _
1240 & "AND updatests = 'A'")
1241 If rsloadlist.EOF = True Then
1242 discamount = "0"
1243 discinfoid = 0
1244 Else
1245 discamount = rsloadlist!discountamount
1246 discinfoid = rsloadlist!discountinfoid
1247 End If
1248 rsloadlist.Close
1249
1250 If discinfoid = 1 Then
1251
1252 vatableprice = 0
1253
1254 Call modmain.rsConnection(rsloadlist, "SELECT * FROM tbl_T_orderdetail " _
1255 & "WHERE transacno = '" & tempbillno & "'")
1256 For ctr = 1 To rsloadlist.RecordCount
1257
1258 stockid = rsloadlist!stockid
1259
1260 If Val(rsloadlist!vatableitem) = 1 Then
1261 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
1262 & "WHERE stockid = '" & stockid & "' " _
1263 & "AND uom = '" & rsloadlist!uom & "'")
1264 If rsstocklib!seniorcitizen = 0 Then
1265 vatableprice = Val(vatableprice) + Val(Format(rsloadlist!finalprice, "###0.00"))
1266 End If
1267 rsstocklib.Close
1268 End If
1269
1270 rsloadlist.MoveNext
1271 Next
1272 rsloadlist.Close
1273
1274 vatableprice = Val(Format(vatableprice, "###0.00"))
1275
1276 Else
1277 Call modmain.rsConnection(rsloadlist, "SELECT SUM(finalprice) AS vatableprice " _
1278 & "FROM tbl_T_orderdetail WHERE transacno = '" & tempbillno & "' " _
1279 & "AND vatableitem = 1")
1280 vatableprice = IIf(IsNull(rsloadlist!vatableprice), "0", rsloadlist!vatableprice)
1281 rsloadlist.Close
1282 End If
1283
1284 vatlessprice = Val(Format(vatableprice, "###0.00")) / Val(1 + vatrate)
1285 vatamount = Val(Format(vatableprice, "###0.00")) - Val(vatlessprice)
1286
1287 Call modmain.rsConnection(rsloadlist, "SELECT SUM(amount) AS tempfinalpayment " _
1288 & "FROM tbl_T_payment WHERE transacno = '" & tempbillno & "' " _
1289 & "AND cancelled = 0")
1290 tempfinalpayment = IIf(IsNull(rsloadlist!tempfinalpayment), "0", rsloadlist!tempfinalpayment)
1291 rsloadlist.Close
1292
1293 lblmove.Visible = False
1294 lblaction.Visible = True
1295 lblaction.Caption = "Total Charges"
1296 txtaction.Visible = True
1297
1298 payableamount = Val(tempfinalprice) - Val(discamount)
1299
1300 txtcharge.Text = Format(tempfinalprice, "#,##0.00")
1301 txtdiscount.Text = Format(discamount, "#,##0.00")
1302 txtvat.Text = Format(vatamount, "#,##0.00")
1303
1304 txtvatlessprice.Text = Format(vatlessprice, "#,##0.00")
1305 txtpayable.Text = Format(payableamount, "#,##0.00")
1306 txtaction.Text = Format(payableamount, "#,##0.00")
1307
1308 If Val(tempfinalpayment) = 0 Then
1309 txtpayment.Text = "0.00"
1310 txtoverdue.Text = Format(Val(payableamount) * -1, "#,##0.00")
1311 Else
1312 txtpayment.Text = Format(tempfinalpayment, "#,##0.00")
1313 txtoverdue.Text = Format(Val(tempfinalpayment) - Val(payableamount), "#,##0.00")
1314 End If
1315
1316 frachoose.Visible = True
1317 lblf10.Visible = True
1318 frapayment.Visible = False
1319 frarecall.Visible = False
1320 Call vieworderlist
1321 frabarcode.Enabled = True
1322 frasearch.Enabled = False
1323 fraview.Enabled = False
1324 fraPCard.Enabled = True
1325 txtbarcode.Text = ""
1326 txtsearch.Text = ""
1327
1328 Screen.MousePointer = vbDefault
1329
1330 txtbarcode.SetFocus
1331 Else
1332 lstrecall.SetFocus
1333 End If
1334 End If
1335End Sub
1336
1337Private Sub cbopaymentmode_Change()
1338 If cbopaymentmode.Text = "CASH" Then
1339 frachoosepayment.Visible = False
1340 fracash.Visible = True
1341 fracard.Visible = False
1342 fraconsumablecharge.Visible = False
1343 fracoupon.Visible = False
1344 Call clearpayment
1345 ElseIf cbopaymentmode.Text = "CREDIT CARD" Then
1346 frachoosepayment.Visible = False
1347 fracash.Visible = False
1348 fracard.Visible = True
1349 fraconsumablecharge.Visible = False
1350 fracoupon.Visible = False
1351 Call loadcard
1352 Call clearpayment
1353 ElseIf cbopaymentmode.Text = "CHARGE" Then
1354 frachoosepayment.Visible = False
1355 fracash.Visible = False
1356 fracard.Visible = False
1357 fraconsumablecharge.Visible = True
1358 fracoupon.Visible = False
1359 Call loadcustomer
1360 Call clearpayment
1361 ElseIf cbopaymentmode.Text = "COUPON" Then
1362 frachoosepayment.Visible = False
1363 fracash.Visible = False
1364 fracard.Visible = False
1365 fraconsumablecharge.Visible = False
1366 fracoupon.Visible = True
1367 Call clearpayment
1368 End If
1369End Sub
1370
1371Private Sub cbopaymentmode_Click(Area As Integer)
1372 If cbopaymentmode.Text = "CASH" Then
1373 frachoosepayment.Visible = False
1374 fracash.Visible = True
1375 fracard.Visible = False
1376 fraconsumablecharge.Visible = False
1377 fracoupon.Visible = False
1378 Call clearpayment
1379 ElseIf cbopaymentmode.Text = "CREDIT CARD" Then
1380 frachoosepayment.Visible = False
1381 fracash.Visible = False
1382 fracard.Visible = True
1383 fraconsumablecharge.Visible = False
1384 fracoupon.Visible = False
1385 Call loadcard
1386 Call clearpayment
1387 ElseIf cbopaymentmode.Text = "CHARGE" Then
1388 frachoosepayment.Visible = False
1389 fracash.Visible = False
1390 fracard.Visible = False
1391 fraconsumablecharge.Visible = True
1392 fracoupon.Visible = False
1393 Call loadcustomer
1394 Call clearpayment
1395 ElseIf cbopaymentmode.Text = "COUPON" Then
1396 frachoosepayment.Visible = False
1397 fracash.Visible = False
1398 fracard.Visible = False
1399 fraconsumablecharge.Visible = False
1400 fracoupon.Visible = True
1401 Call clearpayment
1402 End If
1403End Sub
1404
1405Private Sub txtcash_GotFocus()
1406 Hilighttext txtcash
1407End Sub
1408
1409Private Sub txtcash_KeyPress(KeyAscii As Integer)
1410 If KeyAscii = 13 Then
1411 Hilighttext txtcash
1412 If txtcash.Text = "" Or IsNumeric(txtcash.Text) = False Then
1413 MsgBox "Input payment.", vbCritical, systemname
1414 'txtcash.SetFocus
1415 Exit Sub
1416 End If
1417
1418 If txtPCardNo.Text = "" Or IsNumeric(txtPCardNo.Text) = False Then
1419 If MsgBox("Proceed without Privilege Card ?", vbInformation + vbYesNo, systemname) = vbYes Then
1420 GoTo ProceedtoPayment
1421 Else
1422 txtPCardNo.Enabled = True
1423 txtPCardNo.SetFocus
1424 Exit Sub
1425 End If
1426 End If
1427
1428ProceedtoPayment:
1429
1430 If MsgBox("Save Payment?", vbInformation + vbYesNo, systemname) = vbYes Then
1431
1432 'If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
1433 ' lblf8_Click
1434 'End If
1435
1436
1437 conn.Execute "INSERT INTO tbl_T_payment(transacno,datetimetrx,paymentmodeid," _
1438 & "amount,cancelled,userid,lupdatetime,updatests) VALUES('" & tempbillno _
1439 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1440 & "','" & cbopaymentmode.BoundText & "','" & Format(txtcash.Text, "###0.00") _
1441 & "','0','" & userloginid & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1442 & "','A')"
1443
1444 Call loadpaymentmade
1445
1446 If Val(Format(txtoverdue.Text, "###0.00")) > 0 Then
1447 exactamount = Val(Format(txtcash.Text, "###0.00") - Format(txtoverdue.Text, "###0.00"))
1448 Else
1449 exactamount = Format(txtcash.Text, "###0.00")
1450 End If
1451
1452 conn.Execute "UPDATE tbl_T_payment " _
1453 & "SET exactamount = '" & exactamount & "' " _
1454 & "WHERE transacno = '" & tempbillno & "' AND exactamount IS NULL"
1455
1456 frachoosepayment.Visible = True
1457 fracash.Visible = False
1458 fracard.Visible = False
1459 fraconsumablecharge.Visible = False
1460 fracoupon.Visible = False
1461 Call clearpayment
1462 cbopaymentmode.Text = ""
1463 cbopaymentmode.SetFocus
1464 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
1465 MsgBox "Full payment.", vbInformation, systemname
1466 cbopaymentmode.Enabled = False
1467 frachoose.Visible = True
1468 lblf10.Visible = True
1469 frapayment.Visible = False
1470 frarecall.Visible = False
1471
1472 Call lblf5_Click
1473 End If
1474
1475 Else
1476 frachoosepayment.Visible = True
1477 fracash.Visible = False
1478 fracard.Visible = False
1479 fraconsumablecharge.Visible = False
1480 fracoupon.Visible = False
1481 Call clearpayment
1482 cbopaymentmode.Text = ""
1483 cbopaymentmode.SetFocus
1484 End If
1485
1486
1487
1488 Exit Sub
1489 ElseIf KeyAscii = 46 Then
1490 If InStr(1, txtcash.Text, ".", vbTextCompare) > 1 Then
1491 KeyAscii = 0
1492 MsgBox "Invalid character input.", vbCritical, outletname
1493 txtcash.SetFocus
1494 Else
1495 KeyAscii = moneyentry(KeyAscii)
1496 End If
1497 Else
1498 KeyAscii = moneyentry(KeyAscii)
1499 End If
1500End Sub
1501Private Sub ComputeLoyaltyPoints()
1502On Error GoTo LogError
1503
1504 Dim strsql As String
1505 Dim totalamt As Double
1506 Dim totaldiscAmt As Double
1507 Dim NetAmount As Double
1508 Dim rspcategory As New ADODB.Recordset
1509
1510 If CardnumberExist = False Then
1511 MsgBox "Privilege Card Number does not exist in Master File", vbCritical + vbOKOnly
1512 txtPCardNo.Enabled = True
1513 txtPCardNo.SetFocus
1514 Exit Sub
1515 Else
1516
1517 '---Select Card Number
1518
1519 strsql = "Select a.pcardnumber, b.pctypeid , b.description, b.pointsamtbase, b.pointspesovalue,a.totalpoints,a.totalamt " & _
1520 "From tbl_M_pcardmain a inner join tbl_M_pcardtype b on b.pctypeid = a.pctype " & _
1521 "Where a.pcardnumber = '" & txtPCardNo.Text & "'"
1522 Call modmain.rsConnection(rspcard, strsql)
1523 pcardnumber = rspcard!pcardnumber
1524 pctypeid = rspcard!pctypeid
1525 pointsamtbase = rspcard!pointsamtbase
1526 pointspesovalue = rspcard!pointspesovalue
1527 prevtotalpoints = rspcard!totalpoints
1528 prevtotalamt = rspcard!totalamt
1529
1530 End If
1531
1532 Call modmain.rsConnection(rsdiscount, "SELECT a.stockid, b.prodtypeid, a.finalprice FROM tbl_T_orderdetail a inner join vw_stocklist b on " _
1533 & "a.stockid = b.stockid WHERE a.transacno = '" & transacno & "'")
1534 If rsdiscount.EOF Then
1535 MsgBox "Invalid Transaction !", vbCritical + vbOKOnly
1536 Exit Sub
1537 End If
1538 'discamount = 0
1539 totalamt = 0
1540
1541 Do While Not rsdiscount.EOF
1542 prodtypeid = rsdiscount!prodtypeid
1543 Call modmain.rsConnection(rspcategory, "SELECT a.pointsflag FROM tbl_M_pcardcategory a " _
1544 & "WHERE a.pctypeid = '" & pctypeid & "' and prodtypeID = '" & prodtypeid & "'")
1545 If rspcategory.EOF Then
1546 MsgBox "Invalid Card Category Code !", vbCritical + vbOKOnly
1547 Exit Sub
1548 End If
1549 pointsflag = rspcategory!pointsflag
1550 If pointsflag = 1 Then
1551 totalamt = totalamt + rsdiscount!finalprice
1552 End If
1553
1554 rsdiscount.MoveNext
1555 Loop
1556 rsdiscount.Close
1557
1558
1559 strsql = "SELECT sum(discountamount) as totaldiscAmt " & _
1560 "FROM tbl_T_chargesdiscount WHERE transacno = '" & transacno & "' "
1561 Call modmain.rsConnection(rspos, strsql)
1562 If IsNull(rspos!totaldiscAmt) = True Then
1563 totaldiscAmt = 0
1564 Else
1565 totaldiscAmt = rspos!totaldiscAmt
1566 End If
1567 rspos.Close
1568
1569 NetAmount = totalamt - totaldiscAmt
1570
1571
1572 If NetAmount < pointspesovalue Then
1573 dbltnxpoints = 0
1574 Else
1575 Dim intDivide As Long
1576 Dim dblMod As Double
1577 dblMod = Round(NetAmount, 0) Mod pointspesovalue
1578 intDivide = Round(NetAmount, 0) - dblMod
1579
1580 dbltnxpoints = (intDivide / pointspesovalue) * pointsamtbase
1581
1582 End If
1583
1584
1585
1586 If CentralDBUp = True Then
1587 '-- Insert to Card Transaction Table
1588 strsql = "INSERT INTO tbl_T_pcardtxn(pcardnumber,transacno,tnxdate,tnxsbu, tnxoutlet, tnxpoints, tnxgrossamt, tnxnetamt,begtnxpoint, reverseflag, userid,lastupdate,updatests,transmitstatus, transmitdate) " _
1589 & "VALUES ('" & pcardnumber & "','" & transacno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1590 & "','" & sbucode & "', '" & outletcode _
1591 & "','" & dbltnxpoints _
1592 & "','" & totalamt & "','" & NetAmount & "','" & prevtotalpoints & "', '0', '" & userloginid _
1593 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1594 & "','', '1','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") & "')"
1595
1596 conn.Execute strsql
1597
1598 strsql = "INSERT INTO tbl_T_pcardtxn(pcardnumber,transacno,tnxdate,tnxsbu, tnxoutlet, tnxpoints, tnxgrossamt, tnxnetamt,begtnxpoint, reverseflag, userid,lastupdate,updatests,transmitstatus, transmitdate) " _
1599 & "VALUES ('" & pcardnumber & "','" & transacno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1600 & "','" & sbucode & "','" & outletcode _
1601 & "','" & dbltnxpoints _
1602 & "','" & totalamt & "','" & NetAmount & "','" & prevtotalpoints & "', '0', '" & userloginid _
1603 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1604 & "','', '1','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") & "')"
1605
1606 conn2.Execute strsql
1607 '--Update Card Master
1608 strsql = "UPDATE tbl_M_pcardmain SET totalpoints = '" & (dbltnxpoints + prevtotalpoints) _
1609 & "', totalamt = '" & (NetAmount + prevtotalamt) _
1610 & "', userid = '" & userloginid _
1611 & "', transmitstatus = '1'" _
1612 & ", transmitdate = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
1613 & "', lastupdate = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
1614 & "' WHERE pcardnumber = '" & pcardnumber & "'"
1615
1616 conn.Execute strsql
1617
1618 strsql = "UPDATE tbl_M_pcardmain SET totalpoints = '" & (dbltnxpoints + prevtotalpoints) _
1619 & "', totalamt = '" & (NetAmount + prevtotalamt) _
1620 & "', userid = '" & userloginid _
1621 & "', transmitstatus = '1'" _
1622 & ", transmitdate = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
1623 & "', lastupdate = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
1624 & "' WHERE pcardnumber = '" & pcardnumber & "'"
1625
1626 conn2.Execute strsql
1627
1628 Else
1629
1630 conn.Execute "INSERT INTO tbl_T_pcardtxn(pcardnumber,transacno,tnxdate,tnxsbu, tnxoutlet, tnxpoints, tnxgrossamt, tnxnetamt,begtnxpoint, reverseflag, userid,lastupdate,updatests, transmitstatus) " _
1631 & "VALUES ('" & pcardnumber & "','" & transacno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1632 & "','" & sbucode & "','" & outletcode _
1633 & "','" & dbltnxpoints _
1634 & "','" & totalamt & "','" & NetAmount & "','" & prevtotalpoints & "', '0', '" & userloginid _
1635 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1636 & "','', '0')"
1637
1638 '--Update Card Master
1639 conn.Execute "UPDATE tbl_M_pcardmain SET totalpoints = '" & (dbltnxpoints + prevtotalpoints) _
1640 & "', totalamt = '" & (NetAmount + prevtotalamt) _
1641 & "', userid = '" & userloginid _
1642 & "', transmitstatus = '0'" _
1643 & ", lastupdate = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
1644 & "' WHERE pcardnumber = '" & pcardnumber & "'"
1645 End If
1646
1647 'txtPCardNo.Text = ""
1648 dblTotalPoints = dbltnxpoints + prevtotalpoints
1649
1650 Exit Sub
1651
1652LogError:
1653 LogInfo "Error - " & Err.description
1654 Resume Next
1655
1656End Sub
1657Private Sub txtcardno_GotFocus()
1658 Hilighttext txtcardno
1659End Sub
1660
1661Private Sub txtcardno_KeyPress(KeyAscii As Integer)
1662 KeyAscii = entryfields(KeyAscii)
1663End Sub
1664
1665Private Sub txtapprovalno_GotFocus()
1666 Hilighttext txtapprovalno
1667End Sub
1668
1669Private Sub txtapprovalno_KeyPress(KeyAscii As Integer)
1670 KeyAscii = entryfields(KeyAscii)
1671End Sub
1672
1673Private Sub txtcard_GotFocus()
1674 Hilighttext txtcard
1675End Sub
1676
1677Private Sub txtcard_KeyPress(KeyAscii As Integer)
1678 If KeyAscii = 13 Then
1679 Hilighttext txtcard
1680 If cbocreditcard.Text = "" Or txtcardno.Text = "" Or txtapprovalno.Text = "" Then
1681 MsgBox "Input required fields.", vbCritical, systemname
1682 cbocreditcard.SetFocus
1683 Exit Sub
1684 End If
1685 Call modmain.rsConnection(rscardtype, "SELECT cardnolength FROM tbl_M_cardtype " _
1686 & "WHERE cardtypeid = '" & cbocreditcard.BoundText & "'")
1687 If Len(txtcardno.Text) <> rscardtype!cardnolength Then
1688 MsgBox "Invalid card number.", vbCritical, systemname
1689 txtcardno.SetFocus
1690 Exit Sub
1691 End If
1692 rscardtype.Close
1693
1694 If txtcard.Text = "" Or IsNumeric(txtcard.Text) = False Then
1695 MsgBox "Input payment.", vbCritical, systemname
1696 txtcard.SetFocus
1697 Exit Sub
1698 End If
1699
1700 '-----For Privilege Card
1701
1702 If txtPCardNo.Text = "" Or IsNumeric(txtPCardNo.Text) = False Then
1703 If MsgBox("Proceed without Privilege Card ?", vbInformation + vbYesNo, systemname) = vbYes Then
1704 GoTo ProceedtoPayment
1705 Else
1706 txtPCardNo.Enabled = True
1707 txtPCardNo.SetFocus
1708 Exit Sub
1709 End If
1710 End If
1711
1712ProceedtoPayment:
1713
1714 '-----------------------
1715 If MsgBox("Save Payment?", vbInformation + vbYesNo, systemname) = vbYes Then
1716
1717' If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
1718' lblf8_Click
1719' End If
1720
1721 conn.Execute "INSERT INTO tbl_T_payment(transacno,datetimetrx,paymentmodeid," _
1722 & "amount,exactamount,cardtypeid,cardno,approvalno,reminder,cancelled," _
1723 & "userid,lupdatetime,updatests) VALUES('" & tempbillno _
1724 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1725 & "','" & cbopaymentmode.BoundText & "','" & Format(txtcard.Text, "###0.00") _
1726 & "','" & Format(txtcard.Text, "###0.00") & "','" & cbocreditcard.BoundText _
1727 & "','" & txtcardno.Text & "','" & txtapprovalno.Text _
1728 & "','" & cbocreditcard.Text & "-" & txtapprovalno.Text _
1729 & "','0','" & userloginid & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1730 & "','A')"
1731
1732 Call loadpaymentmade
1733
1734 frachoosepayment.Visible = True
1735 fracash.Visible = False
1736 fracard.Visible = False
1737 fraconsumablecharge.Visible = False
1738 fracoupon.Visible = False
1739 Call clearpayment
1740 cbopaymentmode.Text = ""
1741 cbopaymentmode.SetFocus
1742 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
1743 MsgBox "Full payment.", vbInformation, systemname
1744 cbopaymentmode.Enabled = False
1745 frachoose.Visible = True
1746 lblf10.Visible = True
1747 frapayment.Visible = False
1748 frarecall.Visible = False
1749 Call lblf5_Click
1750 End If
1751
1752
1753 Else
1754 frachoosepayment.Visible = True
1755 fracash.Visible = False
1756 fracard.Visible = False
1757 fraconsumablecharge.Visible = False
1758 fracoupon.Visible = False
1759 Call clearpayment
1760 cbopaymentmode.Text = ""
1761 cbopaymentmode.SetFocus
1762 End If
1763
1764
1765
1766 Exit Sub
1767 ElseIf KeyAscii = 46 Then
1768 If InStr(1, txtcard.Text, ".", vbTextCompare) > 1 Then
1769 KeyAscii = 0
1770 MsgBox "Invalid character input.", vbCritical, outletname
1771 txtcard.SetFocus
1772 Else
1773 KeyAscii = moneyentry(KeyAscii)
1774 End If
1775 Else
1776 KeyAscii = moneyentry(KeyAscii)
1777 End If
1778End Sub
1779
1780Private Sub txtremarks_GotFocus()
1781 Hilighttext txtremarks
1782End Sub
1783
1784Private Sub txtremarks_KeyPress(KeyAscii As Integer)
1785 KeyAscii = entryfields(KeyAscii)
1786End Sub
1787
1788Private Sub txtconsumblecharge_GotFocus()
1789 Hilighttext txtconsumblecharge
1790End Sub
1791
1792Private Sub txtconsumblecharge_KeyPress(KeyAscii As Integer)
1793 If KeyAscii = 13 Then
1794 Hilighttext txtconsumblecharge
1795 If cbocustomer.Text = "" Then
1796 MsgBox "Input customer info.", vbCritical, systemname
1797 cbocustomer.SetFocus
1798 Exit Sub
1799 End If
1800 If txtremarks.Text = "" Then
1801 MsgBox "Input remarks for the payment.", vbCritical, systemname
1802 txtremarks.SetFocus
1803 Exit Sub
1804 End If
1805 If txtconsumblecharge.Text = "" Or IsNumeric(txtconsumblecharge.Text) = False Then
1806 MsgBox "Input payment.", vbCritical, systemname
1807 txtconsumblecharge.SetFocus
1808 Exit Sub
1809 End If
1810
1811
1812 '-----For Privilege Card
1813
1814 If txtPCardNo.Text = "" Or IsNumeric(txtPCardNo.Text) = False Then
1815 If MsgBox("Proceed without Privilege Card ?", vbInformation + vbYesNo, systemname) = vbYes Then
1816 GoTo ProceedtoPayment
1817 Else
1818 txtPCardNo.Enabled = True
1819 txtPCardNo.SetFocus
1820 Exit Sub
1821 End If
1822 End If
1823
1824ProceedtoPayment:
1825
1826 '-----------------------
1827
1828 If MsgBox("Save Payment?", vbInformation + vbYesNo, systemname) = vbYes Then
1829' If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
1830' lblf8_Click
1831' End If
1832
1833 conn.Execute "INSERT INTO tbl_T_payment(transacno,datetimetrx,paymentmodeid," _
1834 & "amount,exactamount,reminder,customerid,cancelled,userid,lupdatetime," _
1835 & "updatests) VALUES('" & tempbillno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1836 & "','" & cbopaymentmode.BoundText & "','" & Format(txtconsumblecharge.Text, "###0.00") _
1837 & "','" & Format(txtconsumblecharge.Text, "###0.00") _
1838 & "','" & txtremarks.Text & " " & cbocustomer.Text _
1839 & "','" & cbocustomer.BoundText & "','0','" & userloginid _
1840 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1841 & "','A')"
1842
1843 Call loadpaymentmade
1844
1845 frachoosepayment.Visible = True
1846 fracash.Visible = False
1847 fracard.Visible = False
1848 fraconsumablecharge.Visible = False
1849 fracoupon.Visible = False
1850 Call clearpayment
1851 cbopaymentmode.Text = ""
1852 cbopaymentmode.SetFocus
1853 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
1854 MsgBox "Full payment.", vbInformation, systemname
1855 cbopaymentmode.Enabled = False
1856 frachoose.Visible = True
1857 lblf10.Visible = True
1858 frapayment.Visible = False
1859 frarecall.Visible = False
1860 Call lblf5_Click
1861 End If
1862
1863
1864 Else
1865 frachoosepayment.Visible = True
1866 fracash.Visible = False
1867 fracard.Visible = False
1868 fraconsumablecharge.Visible = False
1869 fracoupon.Visible = False
1870 Call clearpayment
1871 cbopaymentmode.Text = ""
1872 cbopaymentmode.SetFocus
1873 End If
1874
1875
1876
1877 Exit Sub
1878 ElseIf KeyAscii = 46 Then
1879 If InStr(1, txtconsumblecharge.Text, ".", vbTextCompare) > 1 Then
1880 KeyAscii = 0
1881 MsgBox "Invalid character input.", vbCritical, outletname
1882 txtconsumblecharge.SetFocus
1883 Else
1884 KeyAscii = moneyentry(KeyAscii)
1885 End If
1886 Else
1887 KeyAscii = moneyentry(KeyAscii)
1888 End If
1889End Sub
1890
1891Private Sub txtcouponno_GotFocus()
1892 Hilighttext txtcouponno
1893End Sub
1894
1895Private Sub txtcouponno_KeyPress(KeyAscii As Integer)
1896 KeyAscii = entryfields(KeyAscii)
1897End Sub
1898
1899Private Sub txtcoupon_GotFocus()
1900 Hilighttext txtcoupon
1901End Sub
1902
1903Private Sub txtcoupon_KeyPress(KeyAscii As Integer)
1904 If KeyAscii = 13 Then
1905 Hilighttext txtcoupon
1906 If txtcouponno.Text = "" Then
1907 MsgBox "Input coupon no. for the payment.", vbCritical, systemname
1908 txtcouponno.SetFocus
1909 Exit Sub
1910 End If
1911 If txtcoupon.Text = "" Or IsNumeric(txtcoupon.Text) = False Then
1912 MsgBox "Input payment.", vbCritical, systemname
1913 txtcoupon.SetFocus
1914 Exit Sub
1915 End If
1916
1917
1918 '-----For Privilege Card
1919
1920 If txtPCardNo.Text = "" Or IsNumeric(txtPCardNo.Text) = False Then
1921 If MsgBox("Proceed without Privilege Card ?", vbInformation + vbYesNo, systemname) = vbYes Then
1922 GoTo ProceedtoPayment
1923 Else
1924 txtPCardNo.Enabled = True
1925 txtPCardNo.SetFocus
1926 Exit Sub
1927 End If
1928 End If
1929
1930ProceedtoPayment:
1931
1932 '-----------------------
1933
1934 If MsgBox("Save Payment?", vbInformation + vbYesNo, systemname) = vbYes Then
1935' If MsgBox("Apply Discount?", vbInformation + vbYesNo, systemname) = vbYes Then
1936' lblf8_Click
1937' End If
1938
1939 conn.Execute "INSERT INTO tbl_T_payment(transacno,datetimetrx,paymentmodeid," _
1940 & "amount,exactamount,reminder,cancelled,userid,lupdatetime," _
1941 & "updatests) VALUES('" & tempbillno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1942 & "','" & cbopaymentmode.BoundText & "','" & Format(txtcoupon.Text, "###0.00") _
1943 & "','" & Format(txtcoupon.Text, "###0.00") _
1944 & "','" & txtcouponno.Text & "','0','" & userloginid _
1945 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
1946 & "','A')"
1947
1948 Call loadpaymentmade
1949
1950 frachoosepayment.Visible = True
1951 fracash.Visible = False
1952 fracard.Visible = False
1953 fraconsumablecharge.Visible = False
1954 fracoupon.Visible = False
1955 Call clearpayment
1956 cbopaymentmode.Text = ""
1957 cbopaymentmode.SetFocus
1958 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
1959 MsgBox "Full payment.", vbInformation, systemname
1960 cbopaymentmode.Enabled = False
1961 frachoose.Visible = True
1962 lblf10.Visible = True
1963 frapayment.Visible = False
1964 frarecall.Visible = False
1965 Call lblf5_Click
1966 End If
1967
1968
1969
1970 Else
1971 frachoosepayment.Visible = True
1972 fracash.Visible = False
1973 fracard.Visible = False
1974 fraconsumablecharge.Visible = False
1975 fracoupon.Visible = False
1976 Call clearpayment
1977 cbopaymentmode.Text = ""
1978 cbopaymentmode.SetFocus
1979 End If
1980
1981 Exit Sub
1982 ElseIf KeyAscii = 46 Then
1983 If InStr(1, txtcoupon.Text, ".", vbTextCompare) > 1 Then
1984 KeyAscii = 0
1985 MsgBox "Invalid character input.", vbCritical, outletname
1986 txtcoupon.SetFocus
1987 Else
1988 KeyAscii = moneyentry(KeyAscii)
1989 End If
1990 Else
1991 KeyAscii = moneyentry(KeyAscii)
1992 End If
1993End Sub
1994
1995'*************'
1996'SUB FUNCTIONS'
1997'*************'
1998
1999Sub displaydue()
2000 mainform.Timer1.Enabled = True
2001 MSComm1.CommPort = Val(mscommport)
2002 MSComm1.PortOpen = True
2003 MSComm1.Output = Chr$(12)
2004 MSComm1.Output = "DUE AMT" & Format$(Format$(txtpayable.Text, "#,##0.00"), "@@@@@@@@@@@@@")
2005 MSComm1.PortOpen = False
2006End Sub
2007
2008Sub cleartext()
2009
2010 customerDiscountName = ""
2011 customerDiscountID = ""
2012 txtcharge.Text = "0.00"
2013 txtdiscount.Text = "0.00"
2014 txtvat.Text = "0.00"
2015 txtvatlessprice.Text = "0.00"
2016 txtpayable.Text = "0.00"
2017 txtpayment.Text = "0.00"
2018 txtoverdue.Text = "0.00"
2019 txtsearch.Text = ""
2020 txtbarcode.Text = ""
2021 txtquantity.Text = "1"
2022 firstclick = 0
2023 '--- Remove by RHV 03/13/2012
2024 Call displaydue
2025 '--- Remove by RHV 03/13/2012
2026
2027End Sub
2028
2029Sub clearpayment()
2030
2031
2032 txtcash.Text = ""
2033 'txtPCardNo.Text = ""
2034 cbocreditcard.Text = ""
2035 txtcardno.Text = ""
2036 txtapprovalno.Text = ""
2037 txtcard.Text = ""
2038 cbocustomer.Text = ""
2039 txtremarks.Text = ""
2040 txtconsumblecharge.Text = ""
2041 txtcouponno.Text = ""
2042 txtcoupon.Text = ""
2043End Sub
2044
2045Sub cleardiscount()
2046
2047 cbodiscount.Text = ""
2048 txtdiscountname.Text = ""
2049 txtdiscountrefno.Text = ""
2050End Sub
2051
2052Sub vieworderlist()
2053 frastock.Caption = "List of Orders"
2054 lvwstock.Visible = False
2055 lvworder.Visible = True
2056End Sub
2057
2058Sub viewstocklist()
2059 frastock.Caption = "Stock List"
2060 lvwstock.Visible = True
2061 lvworder.Visible = False
2062End Sub
2063
2064Sub loadbagger()
2065 Set rsbagger = New ADODB.Recordset
2066 rsbagger.Open "SELECT * FROM tbl_M_bagger " _
2067 & "WHERE statusid = 1 ORDER BY bagger", conn, adOpenStatic
2068 Bind_ListToRecordset Me.cbobagger, rsbagger, "baggerid", "bagger"
2069End Sub
2070
2071Sub loadview()
2072 Call modmain.rsConnection(rsview, "SELECT * FROM tbl_M_prodtype " _
2073 & "WHERE statusid = 1 ORDER BY prodtype")
2074 If rsview.EOF = True Then
2075 MsgBox "No product type record inputted." _
2076 & vbCrLf & "This window will close." & vbCrLf _
2077 & "Input product type before proceeding in this module.", vbCritical, systemname
2078 rsview.Close
2079 Unload Me
2080 Else
2081 cboview.Clear
2082 With rsview
2083 .MoveLast
2084 ctr = .RecordCount
2085 .MoveFirst
2086 For ctr1 = 1 To ctr
2087 cboview.AddItem .Fields(2)
2088 .MoveNext
2089 Next
2090 End With
2091 rsview.Close
2092 cboview.AddItem "ALL"
2093 cboview.Text = "ALL"
2094 End If
2095End Sub
2096
2097Sub loadlist(loadlistflag As Boolean)
2098On Error GoTo LogError
2099
2100 Screen.MousePointer = vbHourglass
2101
2102 lvwstock.ListItems.Clear
2103
2104 If loadlistflag = False Then
2105 Call modmain.rsConnection(rsloadlist, "SELECT * FROM vw_stocklist " _
2106 & "WHERE statusid = 1 ORDER BY stockdesc")
2107 Else
2108 If cboview.Text = "ALL" Then
2109 Call modmain.rsConnection(rsloadlist, "SELECT * FROM vw_stocklist " _
2110 & "WHERE statusid = 1 AND stockdesc LIKE '" & txtsearch.Text & "%' " _
2111 & "ORDER BY stockdesc")
2112 Else
2113 Call modmain.rsConnection(rsprodtype, "SELECT * FROM tbl_M_prodtype " _
2114 & "WHERE prodtype = '" & cboview.Text & "'")
2115 prodtypeid = rsprodtype!prodtypeid
2116 rsprodtype.Close
2117 Call modmain.rsConnection(rsloadlist, "SELECT * FROM vw_stocklist " _
2118 & "WHERE statusid = 1 AND prodtypeid = '" & prodtypeid & "' " _
2119 & "AND stockdesc LIKE '" & txtsearch.Text & "%' " _
2120 & "ORDER BY stockdesc")
2121 End If
2122 End If
2123 With rsloadlist
2124 If .EOF = True Then
2125 rsloadlist.Close
2126 If loadlistflag = False Then
2127 MsgBox "No records inputted.", vbCritical, systemname
2128 Else
2129 MsgBox "No record found.", vbCritical, systemname
2130 If cboview.Text <> "ALL" Then
2131 cboview.Text = "ALL"
2132 End If
2133 End If
2134 txtsearch.Text = ""
2135 Else
2136 For ctr = 1 To .RecordCount
2137 Set lstitem = lvwstock.ListItems.Add(, , !stockid)
2138 lstitem.SubItems(1) = !stockcode
2139 lstitem.SubItems(2) = UCase(!stockdesc)
2140 lstitem.SubItems(3) = UCase(!uom)
2141 lstitem.SubItems(4) = Format(!sellingprice, "#,##0.00")
2142
2143 .MoveNext
2144 Next
2145 rsloadlist.Close
2146 End If
2147 End With
2148
2149 Screen.MousePointer = vbDefault
2150
2151 Exit Sub
2152
2153LogError:
2154LogInfo "Error - " & Err.description
2155Resume Next
2156
2157End Sub
2158
2159Sub generatebillno()
2160On Error GoTo LogError
2161
2162 Screen.MousePointer = vbHourglass
2163
2164RETRIEVETEMPBILLNO:
2165 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_transacno " _
2166 & "WHERE suspensiontag IS NULL")
2167 If rspos!accesslocked = 1 Then
2168 rspos.Close
2169 GoTo RETRIEVETEMPBILLNO
2170 Else
2171 conn.Execute "UPDATE tbl_T_transacno SET accesslocked = 1 " _
2172 & "WHERE suspensiontag IS NULL"
2173
2174 tempbillno = Val(rspos!transacno) + 1
2175 rspos.Close
2176
2177 conn.Execute "UPDATE tbl_T_transacno SET accesslocked = 0," _
2178 & "transacno = '" & tempbillno & "' " _
2179 & "WHERE suspensiontag IS NULL"
2180
2181 End If
2182
2183 Screen.MousePointer = vbDefault
2184
2185 Exit Sub
2186
2187LogError:
2188LogInfo "Error - " & Err.description
2189Resume Next
2190
2191End Sub
2192
2193Sub loadsuspend()
2194
2195 Screen.MousePointer = vbHourglass
2196
2197 lstrecall.ListItems.Clear
2198
2199 Call modmain.rsConnection(rsloadlist, "SELECT suspensiontag FROM tbl_T_transacno " _
2200 & "WHERE suspensiontag IS NOT NULL " _
2201 & "AND stationno = '" & stationno & "'")
2202 For ctr = 1 To rsloadlist.RecordCount
2203 Set lstitem = lstrecall.ListItems.Add(, , rsloadlist!suspensiontag)
2204
2205 rsloadlist.MoveNext
2206 Next
2207 rsloadlist.Close
2208
2209 Screen.MousePointer = vbDefault
2210
2211End Sub
2212
2213Public Function PadL(ByVal strOrigString As String, intLen As Integer, strPadChar As String)
2214Dim intCtr As Integer
2215Dim intOrigLen As Integer
2216
2217 intOrigLen = Len(strOrigString)
2218
2219 If intOrigLen > intLen Then
2220 PadL = Mid(strOrigString, 1, intLen)
2221 Else
2222 PadL = String(intLen - intOrigLen, strPadChar) & strOrigString
2223 End If
2224End Function
2225
2226Sub loadpayment()
2227 Set rspaymentmode = New ADODB.Recordset
2228 rspaymentmode.Open "SELECT * FROM tbl_M_paymentmode WHERE statusid = 1", conn, adOpenStatic
2229 Bind_ListToRecordset Me.cbopaymentmode, rspaymentmode, "paymentmodeid", "paymentmode"
2230End Sub
2231
2232Sub loadcard()
2233 Set rscardtype = New ADODB.Recordset
2234 rscardtype.Open "SELECT * FROM tbl_M_cardtype WHERE statusid = 1 ORDER BY cardtype", conn, adOpenStatic
2235 Bind_ListToRecordset Me.cbocreditcard, rscardtype, "cardtypeid", "cardtype"
2236End Sub
2237
2238Sub loadcustomer()
2239 Set rscustomer = New ADODB.Recordset
2240 rscustomer.Open "SELECT * FROM tbl_M_customer WHERE statusid = 1 ORDER BY customername", conn, adOpenStatic
2241 Bind_ListToRecordset Me.cbocustomer, rscustomer, "customerid", "customername"
2242 cbocustomer.Text = ""
2243End Sub
2244
2245Sub loadorders()
2246On Error GoTo LogError
2247
2248 Screen.MousePointer = vbHourglass
2249
2250 lvworder.ListItems.Clear
2251
2252 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
2253 & "WHERE transacno = '" & tempbillno & "'")
2254 For ctr = 1 To rspos.RecordCount
2255 stockid = rspos!stockid
2256 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
2257 & "WHERE stockid = '" & stockid & "' " _
2258 & "AND uom = '" & rspos!uom & "'")
2259 Set lstitem = lvworder.ListItems.Add(, , rspos!stockid)
2260 lstitem.SubItems(1) = rsstocklib!stockcode
2261 lstitem.SubItems(2) = UCase(rsstocklib!stockdesc)
2262 lstitem.SubItems(3) = UCase(rsstocklib!stockshortname)
2263 rsstocklib.Close
2264 lstitem.SubItems(4) = UCase(rspos!uom)
2265 lstitem.SubItems(5) = Format(rspos!sellingprice, "#,##0.00")
2266 lstitem.SubItems(6) = rspos!quantityout
2267 lstitem.SubItems(7) = Format(rspos!finalprice, "#,##0.00")
2268 rspos.MoveNext
2269 Next
2270 rspos.Close
2271
2272 Call loaddetails
2273 Call vieworderlist
2274
2275 frasearch.Enabled = False
2276 fraview.Enabled = False
2277 frabarcode.Enabled = True
2278 fraPCard.Enabled = True
2279 txtbarcode.Text = ""
2280 txtsearch.Text = ""
2281
2282 Screen.MousePointer = vbDefault
2283
2284 If lvworder.ListItems.Count = 0 Then
2285 MsgBox "No more orders made.", vbInformation, systemname
2286 End If
2287
2288 Exit Sub
2289
2290LogError:
2291LogInfo "Error - " & Err.description
2292Resume Next
2293
2294End Sub
2295
2296Sub loaddetails()
2297
2298 lvwdetails.ListItems.Clear
2299
2300 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
2301 & "WHERE transacno = '" & tempbillno & "'")
2302 For ctr = 1 To rspos.RecordCount
2303
2304 stockid = rspos!stockid
2305
2306 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
2307 & "WHERE stockid = '" & stockid & "' " _
2308 & "AND uom = '" & rspos!uom & "'")
2309 If rsstocklib!prodtypeid = 1 Then
2310
2311 Call modmain.rsConnection(rsdetails, "SELECT * FROM vw_stockdetail " _
2312 & "WHERE packid = '" & stockid & "' " _
2313 & "AND statusid = 1 ORDER BY stockdesc")
2314 For ctr1 = 1 To rsdetails.RecordCount
2315 packstockid = rsdetails!stockid
2316 packqty = Val(rsdetails!quantity) * Val(rspos!quantityout)
2317 packuom = UCase(rsdetails!uom)
2318
2319 Set lstitem = lvwdetails.ListItems.Add(, , packstockid)
2320 lstitem.SubItems(1) = rsdetails!stockcode
2321 lstitem.SubItems(2) = UCase(rsdetails!stockdesc)
2322 lstitem.SubItems(3) = UCase(rsdetails!stockshortname) & " (" & UCase(packuom) & ")" & " - " & UCase(rsstocklib!stockshortname)
2323 lstitem.SubItems(4) = UCase(packuom)
2324 lstitem.SubItems(5) = packqty
2325 'txtTotalQty.Text = totalqty + packqty
2326 rsdetails.MoveNext
2327 Next ctr1
2328 rsdetails.Close
2329 Else
2330 Set lstitem = lvwdetails.ListItems.Add(, , rspos!stockid)
2331 lstitem.SubItems(1) = rsstocklib!stockcode
2332 lstitem.SubItems(2) = UCase(rsstocklib!stockdesc)
2333 lstitem.SubItems(3) = UCase(rsstocklib!stockshortname) & " (" & UCase(rspos!uom) & ")"
2334 lstitem.SubItems(4) = UCase(rspos!uom)
2335 lstitem.SubItems(5) = rspos!quantityout
2336 'txtTotalQty.Text = totalqty + rspos!quantityout
2337 End If
2338 rsstocklib.Close
2339
2340 rspos.MoveNext
2341 Next
2342 rspos.Close
2343
2344End Sub
2345
2346Sub loadpaymentmade()
2347 Screen.MousePointer = vbHourglass
2348
2349 Call modmain.rsConnection(rspos, "SELECT SUM(finalprice) AS tempfinalprice " _
2350 & "FROM tbl_T_orderdetail WHERE transacno = '" & tempbillno & "'")
2351
2352
2353 tempfinalprice = IIf(IsNull(rspos!tempfinalprice), "0", rspos!tempfinalprice)
2354 rspos.Close
2355
2356 Call modmain.rsConnection(rspos, "SELECT transacno,discountamount,discountinfoid, vatlessprice " _
2357 & "FROM tbl_T_chargesdiscount WHERE transacno = '" & tempbillno & "' " _
2358 & "AND updatests = 'A'")
2359
2360 If rspos.EOF = True Then
2361 discamount = "0"
2362 discinfoid = 0
2363 Else
2364 discamount = rspos!discountamount
2365 discinfoid = rspos!discountinfoid
2366 'SeniorVatlessPrice = rspos!vatlessprice
2367 SeniorVatlessPrice = IIf(IsNull(rspos!vatlessprice), "0", rspos!vatlessprice)
2368 End If
2369 rspos.Close
2370
2371
2372 If discinfoid = 1 Then 'if senior citizen
2373 totalSeniorCitizenVatableSales = 0
2374 payableamount = 0
2375 vatableprice = 0
2376 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
2377 & "WHERE transacno = '" & tempbillno & "'")
2378 For ctr = 1 To rspos.RecordCount
2379 stockid = rspos!stockid
2380 If Val(rspos!vatableitem) = 1 Then
2381 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
2382 & "WHERE stockid = '" & stockid & "' " _
2383 & "AND uom = '" & rspos!uom & "'")
2384 If rsstocklib!seniorcitizen = 0 Then
2385 vatableprice = Val(vatableprice) + Val(Format(rspos!finalprice, "###0.00"))
2386 End If
2387 rsstocklib.Close
2388 End If
2389 rspos.MoveNext
2390 Next
2391 rspos.Close
2392 vatableprice = Val(Format(vatableprice, "###0.00"))
2393 ' totalSeniorCitizenVatableSales = vatableprice
2394 totalSeniorCitizenVatableSales = vatableprice / 1.12
2395
2396
2397 ElseIf discinfoid = 16 Then
2398 Dim vatexempt As Integer
2399 Dim vatableamount As Double
2400 Dim taxamount As Double
2401 Dim temppayableamount As Double
2402 temppayableamount = 0
2403 vatableamount = 0
2404 totalpwddiscount = 0
2405 totalpayable = 0
2406 totalvatless = 0
2407 totalvatlesspricewithdiscount = 0
2408 totaltax = 0
2409 totalVatable = 0
2410 totalpwddiscount = 0
2411 discamount = 0
2412 charges = 0
2413 discamounttotal = 0
2414 Call modmain.rsConnection(rsdiscount, "SELECT * FROM tbl_T_orderdetail " _
2415 & "WHERE transacno = '" & tempbillno & "'")
2416 For ctr = 1 To rsdiscount.RecordCount
2417 charges = charges + Format(rsdiscount!finalprice, "###0.00")
2418
2419 stockid = rsdiscount!stockid
2420 If Val(rsdiscount!vatableitem) = 1 Then 'if taxable
2421
2422 vatlessprice = Val(Format(rsdiscount!finalprice, "###0.00")) / Val(1 + vatrate)
2423 Else
2424 vatlessprice = Format(rsdiscount!finalprice, "###0.00")
2425 End If
2426
2427 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
2428 & "WHERE stockid = '" & stockid & "' " _
2429 & "AND uom = '" & rsdiscount!uom & "'")
2430
2431 If rsstocklib!seniorcitizen = 1 Then '----------if senior citizen, applicable sa PWD
2432 discamount = Val(Format(vatlessprice, "###0.00")) * discrate
2433 vatableamount = vatlessprice - discamount
2434 totalvatlesspricewithdiscount = totalvatlesspricewithdiscount + Val(Format(vatableamount, "###0.00"))
2435 taxamount = vatableamount * vatrate
2436 totaltax = totaltax + taxamount
2437 temppayableamount = vatableamount + taxamount
2438 totalpayable = totalpayable + temppayableamount
2439 '--- Added RHV 08/17/2011
2440 If rsstocklib!prodtypeid = 10 Then '--- product type is medicine
2441 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00"))
2442 Else
2443 'discamount = Val(discamount) + Val(Format(vatlessprice, "###0.00"))
2444 '------------------
2445 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00")) * Val(discrate)
2446 End If
2447 Else 'if no discount
2448 taxamount = taxamount + vatlessprice * vatrate
2449 totaltax = totaltax + taxamount
2450 totalpayable = totalpayable + Format(rsdiscount!finalprice, "###0.00")
2451 totalvatless = totalvatless + vatlessprice
2452 End If
2453
2454 rsstocklib.Close
2455 discamount = 0
2456 vatableamount = 0
2457 taxamount = 0
2458 temppayableamount = 0
2459 rsdiscount.MoveNext
2460 Next
2461 rsdiscount.Close
2462
2463
2464 totalVatable = totalvatless + totalvatlesspricewithdiscount 'AMOUNT
2465 ' discamounttotal = Val(Format(discamounttotal, "###0.00")) 'PWD DISCOUNT
2466
2467 charges = Val(Format(charges, "###0.00")) 'CHARGES
2468 totalpayable = Val(Format(totalpayable, "###0.00")) ' TOTAL PAYABLE
2469
2470 '---- aug 11, 2012
2471 discamounttotal = charges - totalpayable
2472 discamounttotal = Val(Format(discamounttotal, "###0.00")) 'PWD DISCOUNT
2473
2474 totaltax = Val(Format(totaltax, "###0.00")) 'TAX
2475
2476 txtdiscount.Text = Format(discamounttotal, "#,##0.00")
2477 txtcharge.Text = Format(charges, "#,##0.00")
2478 txtpayable.Text = Format(totalpayable, "#,##0.00")
2479 txtaction.Text = Format(totalpayable, "#,##0.00")
2480 txtvat.Text = Format(totaltax, "#,##0.00")
2481 txtvatlessprice.Text = Format(totalVatable, "#,##0.00")
2482
2483 discamount = Val(Format(discamounttotal, "###0.00"))
2484 Else
2485 Call modmain.rsConnection(rspos, "SELECT SUM(finalprice) AS vatableprice " _
2486 & "FROM tbl_T_orderdetail WHERE transacno = '" & tempbillno & "' " _
2487 & "AND vatableitem = 1")
2488 vatableprice = IIf(IsNull(rspos!vatableprice), "0", rspos!vatableprice)
2489 rspos.Close
2490 End If
2491
2492 vatlessprice = Val(Format(vatableprice, "###0.00")) / Val(1 + vatrate)
2493 vatamount = Val(Format(vatableprice, "###0.00")) - Val(vatlessprice)
2494
2495 Call modmain.rsConnection(rspos, "SELECT SUM(amount) AS tempfinalpayment " _
2496 & "FROM tbl_T_payment WHERE transacno = '" & tempbillno & "' " _
2497 & "AND cancelled = 0")
2498 tempfinalpayment = IIf(IsNull(rspos!tempfinalpayment), "0", rspos!tempfinalpayment)
2499 rspos.Close
2500
2501 lblmove.Visible = False
2502 lblaction.Visible = True
2503 lblaction.Caption = "Total Charges"
2504 txtaction.Visible = True
2505
2506 '--- Added 08/17/2011 RHV - for Senior Citizen
2507
2508 If discinfoid = 1 And discamount <> 0 Then
2509 payableamount = Val(SeniorVatlessPrice) - Val(discamount)
2510 ElseIf Not discinfoid = 16 Then
2511 payableamount = Val(tempfinalprice) - Val(discamount)
2512 End If
2513 'payableamount
2514 '---
2515 If Not discinfoid = 16 Then
2516 txtcharge.Text = Format(tempfinalprice, "#,##0.00")
2517 txtdiscount.Text = Format(discamount, "#,##0.00")
2518 txtvat.Text = Format(vatamount, "#,##0.00")
2519 txtvatlessprice.Text = Format(vatlessprice, "#,##0.00")
2520 txtpayable.Text = Format(payableamount, "#,##0.00")
2521 txtaction.Text = Format(payableamount, "#,##0.00")
2522
2523 End If
2524
2525
2526 '--- Remove by RHV 03/13/2012
2527 'Call displaydue
2528 '--- Remove by RHV 03/13/2012
2529
2530
2531 If Val(tempfinalpayment) = 0 Then
2532 txtpayment.Text = "0.00"
2533 txtoverdue.Text = Format(CDbl(txtaction.Text) * -1, "#,##0.00")
2534 Else
2535 txtpayment.Text = Format(tempfinalpayment, "#,##0.00")
2536 txtoverdue.Text = Format(CDbl(txtpayment.Text) - CDbl(txtaction.Text), "#,##0.00")
2537 End If
2538
2539 Screen.MousePointer = vbDefault
2540
2541End Sub
2542
2543Sub viewitems()
2544On Error GoTo LogError
2545
2546 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
2547 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
2548 Exit Sub
2549 End If
2550
2551 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
2552 MsgBox "Payment was already inputted.", vbInformation, systemname
2553 Exit Sub
2554 End If
2555 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
2556 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
2557 Exit Sub
2558 End If
2559
2560 If lblmove.Visible = True Then
2561 LogInfo "lblmove - Viewing StockList"
2562 Call viewstocklist
2563 LogInfo "lblmove - Loading List"
2564 Call loadlist(False)
2565
2566 lblmove.Visible = False
2567 lblaction.Visible = True
2568 lblaction.Caption = "Choose an item."
2569 txtaction.Visible = False
2570 frasearch.Enabled = True
2571 fraview.Enabled = True
2572 fraPCard.Enabled = True
2573 txtbarcode.Text = ""
2574 txtsearch.Text = ""
2575 txtbarcode.SetFocus
2576 Exit Sub
2577
2578 ElseIf lblaction.Caption = "Choose an item." Then
2579 MsgBox "You are currently choosing an item.", vbInformation, systemname
2580 txtbarcode.SetFocus
2581 Exit Sub
2582
2583 ElseIf lblaction.Caption = "Select an item to edit." Then
2584 MsgBox "You are currently selecting an item to edit." _
2585 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2586 lvworder.SetFocus
2587 Exit Sub
2588
2589 ElseIf lblaction.Caption = "Quantity" Then
2590 MsgBox "You are currently editing the quantity." _
2591 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2592 txtaction.SetFocus
2593 Exit Sub
2594
2595 ElseIf lblaction.Caption = "Select an item to delete." Then
2596 MsgBox "You are currently selecting an item to delete." _
2597 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2598 lvworder.SetFocus
2599 Exit Sub
2600
2601 ElseIf frapayment.Visible = True Then
2602 MsgBox "You are currently transacting a payment." _
2603 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2604 cbopaymentmode.SetFocus
2605 Exit Sub
2606
2607 ElseIf lblaction.Caption = "Suspension Tag" Then
2608 MsgBox "You are currently suspending an order." _
2609 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2610 lvworder.SetFocus
2611 Exit Sub
2612
2613 ElseIf frarecall.Visible = True Then
2614 MsgBox "You are currently recalling a transaction." _
2615 & vbCrLf & "Execute Cancel or Press ESC, before viewing the list of items.", vbCritical, systemname
2616 lstrecall.SetFocus
2617 Exit Sub
2618
2619 ElseIf lblaction.Caption = "Total Charges" Then
2620 LogInfo "lblaction - Viewing Stock List"
2621 Call viewstocklist
2622 LogInfo "lblaction - Loading List"
2623 Call loadlist(False)
2624 lblmove.Visible = False
2625 lblaction.Visible = True
2626 lblaction.Caption = "Choose an item."
2627 txtaction.Visible = False
2628 frasearch.Enabled = True
2629 fraview.Enabled = True
2630 txtbarcode.Text = ""
2631 txtsearch.Text = ""
2632 txtbarcode.SetFocus
2633 Exit Sub
2634
2635 End If
2636
2637 Exit Sub
2638
2639LogError:
2640LogInfo "Error - " & Err.description
2641Resume Next
2642
2643End Sub
2644
2645Sub editorder()
2646
2647 LogInfo "Edit Order Clicked"
2648 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
2649 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
2650 Exit Sub
2651 End If
2652
2653 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
2654 MsgBox "Payment was already inputted.", vbInformation, systemname
2655 Exit Sub
2656 End If
2657 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
2658 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
2659 Exit Sub
2660 End If
2661
2662 If lblmove.Visible = True Then
2663 MsgBox "Nothing to edit." _
2664 & vbCrLf & "Create a new transaction first.", vbCritical, systemname
2665 txtbarcode.SetFocus
2666 Exit Sub
2667
2668 ElseIf lblaction.Caption = "Choose an item." Then
2669 MsgBox "You are currently choosing an item." _
2670 & vbCrLf & "Execute Cancel or Press ESC, before editing an order.", vbCritical, systemname
2671 txtbarcode.SetFocus
2672 Exit Sub
2673
2674 ElseIf lblaction.Caption = "Select an item to edit." Then
2675 MsgBox "You are currently selecting an item to edit.", vbInformation, systemname
2676 lvworder.SetFocus
2677 Exit Sub
2678
2679 ElseIf lblaction.Caption = "Quantity" Then
2680 MsgBox "You are currently editing an item.", vbInformation, systemname
2681 txtaction.SetFocus
2682 Exit Sub
2683
2684 ElseIf lblaction.Caption = "Select an item to delete." Then
2685 MsgBox "You are currently selecting an item to delete." _
2686 & vbCrLf & "Execute Cancel or Press ESC, before editing an order.", vbCritical, systemname
2687 lvworder.SetFocus
2688 Exit Sub
2689
2690 ElseIf frapayment.Visible = True Then
2691 MsgBox "You are currently transacting a payment." _
2692 & vbCrLf & "Execute Cancel or Press ESC, before editing an order.", vbCritical, systemname
2693 cbopaymentmode.SetFocus
2694 Exit Sub
2695
2696 ElseIf lblaction.Caption = "Suspension Tag" Then
2697 MsgBox "You are currently suspending an order." _
2698 & vbCrLf & "Execute Cancel or Press ESC, before editing an order.", vbCritical, systemname
2699 lvworder.SetFocus
2700 Exit Sub
2701
2702 ElseIf frarecall.Visible = True Then
2703 MsgBox "You are currently recalling a transaction." _
2704 & vbCrLf & "Execute Cancel or Press ESC, before editing an order.", vbCritical, systemname
2705 lstrecall.SetFocus
2706 Exit Sub
2707
2708 ElseIf lblaction.Caption = "Total Charges" Then
2709 securityprocno = 2
2710 frapassword.Visible = True
2711 txtposuser.Text = ""
2712 txtpospass.Text = ""
2713 Call enabledisable(False)
2714 txtposuser.SetFocus
2715 Exit Sub
2716
2717 End If
2718End Sub
2719
2720Sub deleteorder()
2721 LogInfo "Delete Order Clicked"
2722 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
2723 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
2724 Exit Sub
2725 End If
2726 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
2727 MsgBox "Payment was already inputted.", vbInformation, systemname
2728 Exit Sub
2729 End If
2730 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
2731 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
2732 Exit Sub
2733 End If
2734
2735 If lblmove.Visible = True Then
2736 MsgBox "Create a new transaction first.", vbCritical, systemname
2737 txtbarcode.SetFocus
2738 Exit Sub
2739
2740 ElseIf lblaction.Caption = "Choose an item." Then
2741 MsgBox "You are currently choosing an item." _
2742 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2743 txtbarcode.SetFocus
2744 Exit Sub
2745
2746 ElseIf lblaction.Caption = "Select an item to edit." Then
2747 MsgBox "You are currently selecting an item to edit." _
2748 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2749 lvworder.SetFocus
2750 Exit Sub
2751
2752 ElseIf lblaction.Caption = "Quantity" Then
2753 MsgBox "You are currently editing an item." _
2754 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2755 txtaction.SetFocus
2756 Exit Sub
2757
2758 ElseIf lblaction.Caption = "Select an item to delete." _
2759 And lblf3.Caption = "F3 - Delete" Then
2760
2761 If MsgBox("Are you sure you want to delete this order?", vbInformation + vbYesNo, systemname) = vbYes Then
2762
2763 conn.Execute "DELETE FROM tbl_T_orderdetail " _
2764 & "WHERE transacno = '" & tempbillno & "' " _
2765 & "AND stockid = '" & lvworder.SelectedItem & "' " _
2766 & "AND uom = '" & UCase(lvworder.SelectedItem.ListSubItems(4).Text) & "'"
2767
2768 Call loadorders
2769 Call loadpaymentmade
2770 Call TotalCountItems
2771
2772 lblf3.Caption = "F3 - Delete Order"
2773 txtbarcode.SetFocus
2774 Else
2775 lvworder.SetFocus
2776 End If
2777
2778 ElseIf frapayment.Visible = True Then
2779 MsgBox "You are currently transacting a payment." _
2780 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2781 cbopaymentmode.SetFocus
2782 Exit Sub
2783
2784 ElseIf lblaction.Caption = "Suspension Tag" Then
2785 MsgBox "You are currently suspending an order." _
2786 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2787 lvworder.SetFocus
2788 Exit Sub
2789
2790 ElseIf frarecall.Visible = True Then
2791 MsgBox "You are currently recalling a transaction." _
2792 & vbCrLf & "Execute Cancel or Press ESC, before deleting an order.", vbCritical, systemname
2793 lstrecall.SetFocus
2794 Exit Sub
2795
2796 ElseIf lblaction.Caption = "Total Charges" Then
2797 If lvworder.ListItems.Count = 0 Then
2798 MsgBox "No more orders to delete.", vbCritical, systemname
2799 txtbarcode.SetFocus
2800 Exit Sub
2801 End If
2802 securityprocno = 3
2803 frapassword.Visible = True
2804 txtposuser.Text = ""
2805 txtpospass.Text = ""
2806 Call enabledisable(False)
2807 txtposuser.SetFocus
2808 Exit Sub
2809
2810 End If
2811End Sub
2812
2813Sub inputpayment()
2814 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
2815 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
2816 Exit Sub
2817 End If
2818 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
2819 Exit Sub
2820 End If
2821
2822 If lblmove.Visible = True Then
2823 MsgBox "Create a new transaction first.", vbCritical, systemname
2824 txtbarcode.SetFocus
2825 Exit Sub
2826
2827 ElseIf lblaction.Caption = "Choose an item." Then
2828 MsgBox "You are currently choosing an item." _
2829 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2830 txtbarcode.SetFocus
2831 Exit Sub
2832
2833 ElseIf lblaction.Caption = "Select an item to edit." Then
2834 MsgBox "You are currently selecting an item to edit." _
2835 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2836 lvworder.SetFocus
2837 Exit Sub
2838
2839 ElseIf lblaction.Caption = "Quantity" Then
2840 MsgBox "You are currently editing an item." _
2841 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2842 txtaction.SetFocus
2843 Exit Sub
2844
2845 ElseIf lblaction.Caption = "Select an item to delete." Then
2846 MsgBox "You are currently selecting an item to delete." _
2847 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2848 lvworder.SetFocus
2849 Exit Sub
2850
2851 ElseIf frapayment.Visible = True Then
2852 MsgBox "You are currently transacting a payment.", vbInformation, systemname
2853 Exit Sub
2854
2855 ElseIf lblaction.Caption = "Suspension Tag" Then
2856 MsgBox "You are currently suspending an order." _
2857 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2858 lvworder.SetFocus
2859 Exit Sub
2860
2861 ElseIf frarecall.Visible = True Then
2862 MsgBox "You are currently recalling a transaction." _
2863 & vbCrLf & "Execute Cancel or Press ESC, before transacting a payment.", vbCritical, systemname
2864 lstrecall.SetFocus
2865 Exit Sub
2866
2867 ElseIf lblaction.Caption = "Total Charges" Then
2868 If lvworder.ListItems.Count = 0 Then
2869 MsgBox "Nothing to pay.", vbCritical, systemname
2870 txtbarcode.SetFocus
2871 Exit Sub
2872 End If
2873
2874 frabarcode.Enabled = False
2875 frachoose.Visible = False
2876 lblf10.Visible = False
2877 frapayment.Visible = True
2878 frarecall.Visible = False
2879 cbopaymentmode.Enabled = True
2880 cbopaymentmode.SetFocus
2881 Call loadpayment
2882 frachoosepayment.Visible = True
2883 fracash.Visible = False
2884 fracard.Visible = False
2885 fraconsumablecharge.Visible = False
2886 cbopaymentmode.Text = ""
2887 End If
2888End Sub
2889
2890Sub printbill()
2891On Error GoTo LogError
2892Dim pwd As Boolean
2893pwd = False
2894Dim senior_citizen As Boolean
2895senior_citizen = False
2896Dim rsCheckDiscount As New ADODB.Recordset
2897
2898
2899
2900
2901 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
2902 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
2903 Exit Sub
2904 End If
2905
2906 If Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) _
2907 And Val(Format(txtpayment.Text, "###0.00")) > 0 Then
2908
2909 Screen.MousePointer = vbHourglass
2910
2911 If Len(tempbillno) = 10 Then
2912 transacno = tempbillno
2913 Else
2914RETRIEVEBILLNO:
2915 LogInfo "Accessing Bill No"
2916
2917 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_M_syscon " _
2918 & "WHERE modulename = 'CHARGES'")
2919 If rspos!accesslocked = 1 Then
2920 rspos.Close
2921 LogInfo "Bill No locked"
2922 GoTo RETRIEVEBILLNO
2923 Else
2924 LogInfo "Updating Bill No"
2925 conn.Execute "UPDATE tbl_M_syscon SET accesslocked = 1 " _
2926 & "WHERE modulename = 'CHARGES'"
2927
2928 billno = Val(rspos!lastnumber) + 1
2929 rspos.Close
2930
2931 conn.Execute "UPDATE tbl_M_syscon SET accesslocked = 0," _
2932 & "lastnumber = '" & billno & "' " _
2933 & "WHERE modulename = 'CHARGES'"
2934
2935 End If
2936
2937 transacno = PadL(billno, 10, "0")
2938
2939 LogInfo "Processing Bill No.: " & billno
2940
2941 Call modmain.rsConnection(rsCheckDiscount, "SELECT * FROM tbl_T_chargesdiscount " _
2942 & "WHERE transacno = '" & tempbillno & "'")
2943 If rsCheckDiscount.RecordCount > 0 Then
2944 If rsCheckDiscount!discountinfoid = 16 Then
2945 pwd = True
2946 ElseIf rsCheckDiscount!discountinfoid = 1 Then
2947 senior_citizen = True
2948
2949 End If
2950 End If
2951
2952 End If
2953 '--- Added by RHV 11/07/2011 for BIR
2954 Dim reportflag As String
2955 Call modmain.rsConnection(rsBIR, "SELECT * FROM tbl_M_reportBIR ")
2956 Dim countergap As Integer
2957 countergap = rsBIR!countergap
2958
2959 If CDbl(transacno) Mod countergap = 0 Then
2960 reportflag = "1"
2961RETRIEVEBILLNOBIR:
2962 LogInfo "Accessing BIR Bill No Series"
2963
2964 Call modmain.rsConnection(rsSeries, "SELECT * FROM tbl_M_syscon " _
2965 & "WHERE modulename = 'CHARGESBIR'")
2966 If rsSeries!accesslocked = 1 Then
2967 rsSeries.Close
2968 LogInfo "BIR Bill No Series Locked"
2969 GoTo RETRIEVEBILLNOBIR
2970 Else
2971 LogInfo "Updating BIR Bill No Series"
2972 conn.Execute "UPDATE tbl_M_syscon SET accesslocked = 1 " _
2973 & "WHERE modulename = 'CHARGESBIR'"
2974 billnoBIR = Val(rsSeries!lastnumber) + 1
2975
2976 conn.Execute "UPDATE tbl_M_syscon SET accesslocked = 0," _
2977 & "lastnumber = '" & billnoBIR & "' " _
2978 & "WHERE modulename = 'CHARGESBIR'"
2979 End If
2980 transacnoBIR = PadL(billnoBIR, 10, "0")
2981 LogInfo "Processing BIR Bill No.: " & billnoBIR
2982 Else
2983 transacnoBIR = ""
2984 reportflag = "0"
2985 End If
2986 'rsSeries.Close
2987 '--- End Added by RHV 11/07/2011 for BIR
2988
2989 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_orderdetail " _
2990 & "WHERE transacno = '" & tempbillno & "' " _
2991 & "AND temporder = 1")
2992 For ctr = 1 To rspos.RecordCount
2993 stockid = rspos!stockid
2994 quantityout = rspos!quantityout
2995 uom = UCase(rspos!uom)
2996 vatableitem = rspos!vatableitem
2997 sellingprice = Format(rspos!finalprice, "###0.00")
2998
2999 Call modmain.rsConnection(rsprodtype, "SELECT * FROM tbl_M_stocklibrary " _
3000 & "WHERE stockid = '" & stockid & "'")
3001 prodtypeid = rsprodtype!prodtypeid
3002 rsprodtype.Close
3003
3004 If prodtypeid = 1 Then
3005 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stockdetail " _
3006 & "WHERE packid = '" & stockid & "' " _
3007 & "AND statusid = 1 ORDER BY stockdesc")
3008 For ctr1 = 1 To rsstocklib.RecordCount
3009 packstockid = rsstocklib!stockid
3010 packqty = rsstocklib!quantity
3011 packuom = UCase(rsstocklib!uom)
3012
3013 Call modmain.rsConnection(rsstockout, "SELECT * FROM tbl_M_stockuom " _
3014 & "WHERE statusid = 1 AND stockid = '" & packstockid & "' " _
3015 & "AND uom = '" & UCase(packuom) & "'")
3016 uomdivisor = Val(rsstockout!quantity)
3017 rsstockout.Close
3018
3019 qtysold = Format(Val(quantityout * packqty) / Val(uomdivisor), "###0.00")
3020
3021 Call modmain.rsConnection(rsstockinv, "SELECT * FROM tbl_T_stockinventory " _
3022 & "WHERE stockid = '" & packstockid & "' " _
3023 & "AND lastinv = 1")
3024 If rsstockinv.EOF = True Then
3025
3026 Call modmain.rsConnection(rsstockout, "SELECT * FROM tbl_T_stockinventory " _
3027 & "WHERE stockid = '" & packstockid & "' " _
3028 & "ORDER BY inventorydate DESC")
3029 beginningbal = rsstockout!endingbal
3030 rsstockout.Close
3031
3032 quantityin = 0
3033 quantityadd = 0
3034 quantityminus = 0
3035 quantityreturned = 0
3036 quantitydamaged = 0
3037 quantitytransfer = 0
3038 quantitypullout = 0
3039 quantitysold = Val(qtysold)
3040 endingbal = Val(beginningbal) - Val(qtysold)
3041
3042 conn.Execute "UPDATE tbl_T_stockinventory SET lastinv = 0 " _
3043 & "WHERE stockid = '" & packstockid & "'"
3044
3045 conn.Execute "INSERT INTO tbl_T_stockinventory(stockid,beginningbal," _
3046 & "quantityin,quantityadd,quantityminus,quantityreturned," _
3047 & "quantitydamaged,quantitytransfer,quantitypullout,quantitysold," _
3048 & "endingbal,inventorydate,userid,lupdatetime,updatests,lastinv) " _
3049 & "VALUES('" & packstockid & "','" & beginningbal _
3050 & "','" & quantityin & "','" & quantityadd _
3051 & "','" & quantityminus & "','" & quantityreturned _
3052 & "','" & quantitydamaged & "','" & quantitytransfer _
3053 & "','" & quantitypullout & "','" & quantitysold _
3054 & "','" & endingbal & "','" & Format(Now(), "mm/dd/yyyy") _
3055 & "','" & userloginid & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
3056 & "','A','1')"
3057
3058 Else
3059 beginningbal = rsstockinv!beginningbal
3060 quantityin = rsstockinv!quantityin
3061 quantityadd = rsstockinv!quantityadd
3062 quantityminus = rsstockinv!quantityminus
3063 quantityreturned = rsstockinv!quantityreturned
3064 quantitydamaged = rsstockinv!quantitydamaged
3065 quantitytransfer = rsstockinv!quantitytransfer
3066 quantitypullout = rsstockinv!quantitypullout
3067 quantitysold = Val(rsstockinv!quantitysold) + Val(qtysold)
3068 endingbal = Val(rsstockinv!endingbal) - Val(qtysold)
3069
3070 conn.Execute "UPDATE tbl_T_stockinventory SET beginningbal = '" & beginningbal _
3071 & "', quantityin = '" & quantityin _
3072 & "', quantityadd = '" & quantityadd _
3073 & "', quantityminus = '" & quantityminus _
3074 & "', quantityreturned = '" & quantityreturned _
3075 & "', quantitydamaged = '" & quantitydamaged _
3076 & "', quantitytransfer = '" & quantitytransfer _
3077 & "', quantitypullout = '" & quantitypullout _
3078 & "', quantitysold = '" & quantitysold _
3079 & "', endingbal = '" & endingbal _
3080 & "', inventorydate = '" & Format(Now(), "mm/dd/yyyy") _
3081 & "', userid = '" & userloginid _
3082 & "', lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
3083 & "', updatests = 'U' WHERE stockid = '" & packstockid _
3084 & "' AND lastinv = 1"
3085
3086 End If
3087 rsstockinv.Close
3088
3089 conn.Execute "UPDATE tbl_M_stocklibrary " _
3090 & "SET endingbal = '" & endingbal & "' " _
3091 & "WHERE stockid = '" & packstockid & "'"
3092
3093 rsstocklib.MoveNext
3094 Next
3095 rsstocklib.Close
3096
3097 Else
3098 Call modmain.rsConnection(rsstockout, "SELECT * FROM tbl_M_stockuom " _
3099 & "WHERE statusid = 1 AND stockid = '" & stockid & "' " _
3100 & "AND uom = '" & UCase(uom) & "'")
3101 uomdivisor = Val(rsstockout!quantity)
3102 rsstockout.Close
3103
3104 qtysold = Format(Val(quantityout) / Val(uomdivisor), "###0.00")
3105
3106 Call modmain.rsConnection(rsstockinv, "SELECT * FROM tbl_T_stockinventory " _
3107 & "WHERE stockid = '" & stockid & "' " _
3108 & "AND lastinv = 1")
3109 If rsstockinv.EOF = True Then
3110
3111 Call modmain.rsConnection(rsstockout, "SELECT * FROM tbl_T_stockinventory " _
3112 & "WHERE stockid = '" & stockid & "' " _
3113 & "ORDER BY inventorydate DESC")
3114 beginningbal = rsstockout!endingbal
3115 rsstockout.Close
3116
3117 quantityin = 0
3118 quantityadd = 0
3119 quantityminus = 0
3120 quantityreturned = 0
3121 quantitydamaged = 0
3122 quantitytransfer = 0
3123 quantitypullout = 0
3124 quantitysold = Val(qtysold)
3125 endingbal = Val(beginningbal) - Val(qtysold)
3126
3127 conn.Execute "UPDATE tbl_T_stockinventory SET lastinv = 0 " _
3128 & "WHERE stockid = '" & stockid & "'"
3129
3130 conn.Execute "INSERT INTO tbl_T_stockinventory(stockid,beginningbal," _
3131 & "quantityin,quantityadd,quantityminus,quantityreturned," _
3132 & "quantitydamaged,quantitytransfer,quantitypullout,quantitysold," _
3133 & "endingbal,inventorydate,userid,lupdatetime,updatests,lastinv) " _
3134 & "VALUES('" & stockid & "','" & beginningbal & "','" & quantityin _
3135 & "','" & quantityadd & "','" & quantityminus & "','" & quantityreturned _
3136 & "','" & quantitydamaged & "','" & quantitytransfer _
3137 & "','" & quantitypullout & "','" & quantitysold _
3138 & "','" & endingbal & "','" & Format(Now(), "mm/dd/yyyy") _
3139 & "','" & userloginid & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
3140 & "','A','1')"
3141
3142 Else
3143 beginningbal = rsstockinv!beginningbal
3144 quantityin = rsstockinv!quantityin
3145 quantityadd = rsstockinv!quantityadd
3146 quantityminus = rsstockinv!quantityminus
3147 quantityreturned = rsstockinv!quantityreturned
3148 quantitydamaged = rsstockinv!quantitydamaged
3149 quantitytransfer = rsstockinv!quantitytransfer
3150 quantitypullout = rsstockinv!quantitypullout
3151 quantitysold = Val(rsstockinv!quantitysold) + Val(qtysold)
3152 endingbal = Val(rsstockinv!endingbal) - Val(qtysold)
3153
3154 conn.Execute "UPDATE tbl_T_stockinventory SET beginningbal = '" & beginningbal _
3155 & "', quantityin = '" & quantityin _
3156 & "', quantityadd = '" & quantityadd _
3157 & "', quantityminus = '" & quantityminus _
3158 & "', quantityreturned = '" & quantityreturned _
3159 & "', quantitydamaged = '" & quantitydamaged _
3160 & "', quantitytransfer = '" & quantitytransfer _
3161 & "', quantitypullout = '" & quantitypullout _
3162 & "', quantitysold = '" & quantitysold _
3163 & "', endingbal = '" & endingbal _
3164 & "', inventorydate = '" & Format(Now(), "mm/dd/yyyy") _
3165 & "', userid = '" & userloginid _
3166 & "', lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
3167 & "', updatests = 'U' WHERE stockid = '" & stockid _
3168 & "' AND lastinv = 1"
3169
3170 End If
3171 rsstockinv.Close
3172
3173 conn.Execute "UPDATE tbl_M_stocklibrary " _
3174 & "SET endingbal = '" & endingbal & "' " _
3175 & "WHERE stockid = '" & stockid & "'"
3176
3177 End If
3178
3179 If Val(vatableitem) = 1 Then 'if item is vatable
3180 '---if PWD discount
3181 If pwd = True Then
3182 vatlessprice = (Val(sellingprice) / Val(1 + vatrate)) - Format(txtdiscount.Text, "###0.00")
3183 vatamount = Val(Format(sellingprice, "###0.00")) - Val(vatlessprice)
3184 Else
3185 vatlessprice = Val(sellingprice) / Val(1 + vatrate)
3186 vatamount = Val(Format(sellingprice, "###0.00")) - Val(vatlessprice)
3187 End If
3188 Else
3189 vatlessprice = 0
3190 vatamount = 0
3191 End If
3192
3193
3194 '--- Added for Senior Citizen Returns by RHV 09/01/2011
3195 If discinfoid = 16 Or discinfoid = 1 Then
3196 conn.Execute "UPDATE tbl_T_orderdetail SET transacno = '" & transacno & "'," _
3197 & "temporder = '0', suspensiontag = 'NOT'," _
3198 & "vatamount = '" & Format(vatamount, "###0.00") & "'," _
3199 & "vatlessprice = '" & Format(vatlessprice, "###0.00") & "', " _
3200 & "discinfoid = '" & discinfoid & "', " _
3201 & "reportflag = '" & reportflag & "', " _
3202 & "transacnoBIR = '" & transacnoBIR & "' " _
3203 & "WHERE transacno = '" & tempbillno & "' " _
3204 & "AND stockid = '" & stockid & "' " _
3205 & "AND uom = '" & uom & "'"
3206 Else
3207 conn.Execute "UPDATE tbl_T_orderdetail SET transacno = '" & transacno & "'," _
3208 & "temporder = '0', suspensiontag = 'NOT'," _
3209 & "vatamount = '" & Format(vatamount, "###0.00") & "'," _
3210 & "vatlessprice = '" & Format(vatlessprice, "###0.00") & "', " _
3211 & "reportflag = '" & reportflag & "', " _
3212 & "transacnoBIR = '" & transacnoBIR & "' " _
3213 & "WHERE transacno = '" & tempbillno & "' " _
3214 & "AND stockid = '" & stockid & "' " _
3215 & "AND uom = '" & uom & "'"
3216 End If
3217 '---
3218 rspos.MoveNext
3219 Next
3220 rspos.Close
3221
3222 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_charges " _
3223 & "WHERE transacno = '" & transacno & "'")
3224
3225 If rspos.EOF = True Then
3226 If pwd Then
3227 conn.Execute "INSERT INTO tbl_T_charges(transacno,datetimetrx,charges," _
3228 & "discount,vat,payment,overdue,userid,lupdatetime,updatests,stationno," _
3229 & "shiftno,baggerid,vatlessprice, reportflag, transacnoBIR, vatablesales) " _
3230 & "VALUES('" & transacno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
3231 & "','" & Format(txtcharge.Text, "###0.00") _
3232 & "','" & Format(txtdiscount.Text, "###0.00") _
3233 & "','" & Format(totaltax, "###0.00") _
3234 & "','" & Format(txtpayment.Text, "###0.00") _
3235 & "','" & Format(txtoverdue.Text, "###0.00") & "','" & userloginid _
3236 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
3237 & "','A','" & stationno & "','" & shiftno & "','" & baggerid _
3238 & "','" & Format(totalVatable, "###0.00") & "', '" & reportflag _
3239 & "','" & transacnoBIR _
3240 & "','" & Format(txtaction.Text, "###0.00") & "' )"
3241 Else
3242
3243 conn.Execute "INSERT INTO tbl_T_charges(transacno,datetimetrx,charges," _
3244 & "discount,vat,payment,overdue,userid,lupdatetime,updatests,stationno," _
3245 & "shiftno,baggerid,vatlessprice, reportflag, transacnoBIR) " _
3246 & "VALUES('" & transacno & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
3247 & "','" & Format(txtcharge.Text, "###0.00") _
3248 & "','" & Format(txtdiscount.Text, "###0.00") _
3249 & "','" & Format(txtvat.Text, "###0.00") _
3250 & "','" & Format(txtpayment.Text, "###0.00") _
3251 & "','" & Format(txtoverdue.Text, "###0.00") & "','" & userloginid _
3252 & "','" & Format(Now(), "mm/dd/yyyy") & " " & Format(Now(), "hh:mm:ss AM/PM") _
3253 & "','A','" & stationno & "','" & shiftno & "','" & baggerid _
3254 & "','" & Format(txtvatlessprice.Text, "###0.00") & "', '" & reportflag _
3255 & "','" & transacnoBIR & "' )"
3256 End If
3257 Else
3258 customerDiscountName = ""
3259 customerDiscountID = ""
3260
3261 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
3262 & "charges = '" & Format(txtcharge.Text, "###0.00") & "'," _
3263 & "discount = '" & Format(txtdiscount.Text, "###0.00") & "'," _
3264 & "vat = '" & Format(txtvat.Text, "###0.00") & "'," _
3265 & "vatlessprice = '" & Format(txtvatlessprice.Text, "###0.00") & "'," _
3266 & "payment = '" & Format(txtpayment.Text, "###0.00") & "'," _
3267 & "overdue = '" & Format(txtoverdue.Text, "###0.00") & "'," _
3268 & "shiftno = '" & shiftno & "', baggerid = '" & baggerid & "'," _
3269 & "userid = '" & userloginid & "'," _
3270 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
3271 & "updatests = 'U', stationno = '" & stationno & "', reportflag = '" & reportflag & "' " _
3272 & "transacnoBIR = '" & transacnoBIR & "' " _
3273 & "WHERE transacno = '" & transacno & "'"
3274 End If
3275 'Orig data txtvatlessprice.Text
3276
3277 rspos.Close
3278
3279 conn.Execute "UPDATE tbl_T_payment SET transacno = '" & transacno & "'," _
3280 & "reportflag = '" & reportflag & "', " _
3281 & "transacnoBIR = '" & transacnoBIR & "'" _
3282 & "WHERE transacno = '" & tempbillno & "'"
3283
3284 conn.Execute "UPDATE tbl_T_chargesdiscount SET transacno = '" & transacno _
3285 & "' WHERE transacno = '" & tempbillno & "'"
3286
3287 conn.Execute "DELETE FROM tbl_T_transacno " _
3288 & "WHERE suspendtransacno = '" & tempbillno & "' " _
3289 & "AND stationno = '" & stationno & "'"
3290
3291 tempbillno = ""
3292
3293 Screen.MousePointer = vbDefault
3294
3295 MSComm1.CommPort = Val(mscommport)
3296 MSComm1.PortOpen = True
3297 MSComm1.Output = Chr$(12)
3298 MSComm1.Output = "CHANGE" & Space$(1) & Format$(Format$(txtoverdue.Text, "#,##0.00"), "@@@@@@@@@@@@@")
3299 MSComm1.PortOpen = False
3300
3301 firstload = True
3302 boldrawer = True
3303 'Uncomment this, for testing only...
3304 fradrawer.Visible = True
3305 '---------
3306 Call enabledisable(False)
3307 Call usevariables
3308 If txtPCardNo.Text <> "" Then
3309 LogInfo "Computing Loyalty Points"
3310 Call ComputeLoyaltyPoints
3311 End If
3312 LogInfo "Print Bill Start"
3313 Call printfunction
3314 LogInfo "Print Bill Ends"
3315 If reportflag = "1" Then
3316 LogInfo "Print BIR Bill Start"
3317 Call printfunctionBIR
3318 LogInfo "Print BIR Bill Ends"
3319 End If
3320 '-----Pls. delete this, for testing only...
3321 'Text3.Text = "Open"
3322 'Text3.Text = "Close"
3323 'For RFID
3324 '--- Remove Activation of Timer3 upon form load by RHV 03/13/2012
3325' If InitRF = True Then
3326' mainform.Timer3.Enabled = True
3327' Else
3328' mainform.Timer3.Enabled = False
3329' MsgBox "Card Reader Facility is disabled, pls. restart application and Card Reader !", vbInformation + vbOKOnly, systemname
3330' txtbarcode.SetFocus
3331' End If
3332 '--- Remove Activation of Timer3 upon form load by RHV 03/13/2012
3333
3334 Exit Sub
3335
3336 txtPCardNo.Text = ""
3337 '-------
3338
3339 End If
3340
3341 Exit Sub
3342
3343LogError:
3344LogInfo "Error - " & Err.description
3345Resume Next
3346
3347End Sub
3348
3349Sub suspendtransac()
3350On Error GoTo LogError
3351
3352 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
3353 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
3354 Exit Sub
3355 End If
3356 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
3357 MsgBox "Payment was already inputted.", vbInformation, systemname
3358 Exit Sub
3359 End If
3360 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
3361 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
3362 Exit Sub
3363 End If
3364
3365 If lblmove.Visible = True Then
3366 MsgBox "Create a new transaction first.", vbCritical, systemname
3367 txtbarcode.SetFocus
3368 Exit Sub
3369
3370 ElseIf lblaction.Caption = "Choose an item." Then
3371 MsgBox "You are currently choosing an item." _
3372 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3373 txtbarcode.SetFocus
3374 Exit Sub
3375
3376 ElseIf lblaction.Caption = "Select an item to edit." Then
3377 MsgBox "You are currently selecting an item to edit." _
3378 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3379 lvworder.SetFocus
3380 Exit Sub
3381
3382 ElseIf lblaction.Caption = "Quantity" Then
3383 MsgBox "You are currently editing an item." _
3384 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3385 txtaction.SetFocus
3386 Exit Sub
3387
3388 ElseIf lblaction.Caption = "Select an item to delete." Then
3389 MsgBox "You are currently selecting an item to delete." _
3390 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3391 lvworder.SetFocus
3392 Exit Sub
3393
3394 ElseIf frapayment.Visible = True Then
3395 MsgBox "You are currently transacting a payment." _
3396 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3397 cbopaymentmode.SetFocus
3398 Exit Sub
3399
3400 ElseIf frarecall.Visible = True Then
3401 MsgBox "You are currently recalling a transaction." _
3402 & vbCrLf & "Execute Cancel or Press ESC, before suspending an order.", vbCritical, systemname
3403 lstrecall.SetFocus
3404 Exit Sub
3405
3406 ElseIf lblaction.Caption = "Suspension Tag" _
3407 And lblf6.Caption = "F6 - Suspend" Then
3408
3409 If MsgBox("Are you sure you want to suspend this transaction?", vbInformation + vbYesNo, systemname) = vbYes Then
3410
3411 suspendtag = suspendini & "-" & txtaction.Text
3412
3413 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_transacno " _
3414 & "WHERE suspensiontag = '" & suspendtag & "' " _
3415 & "AND stationno = '" & stationno & "'")
3416 If rspos.EOF = False Then
3417 MsgBox "Suspension tag already exist.", vbCritical, systemname
3418 rspos.Close
3419 txtaction.SetFocus
3420 Exit Sub
3421 Else
3422 conn.Execute "INSERT INTO tbl_T_transacno(suspensiontag,suspendtransacno," _
3423 & "stationno) VALUES('" & suspendtag & "','" & tempbillno _
3424 & "','" & stationno & "')"
3425
3426 conn.Execute "UPDATE tbl_T_orderdetail " _
3427 & "SET suspensiontag = '" & suspendtag & "' " _
3428 & "WHERE transacno = '" & tempbillno & "'"
3429
3430 rspos.Close
3431 End If
3432
3433 lvworder.ListItems.Clear
3434 lblmove.Visible = True
3435 lblaction.Visible = False
3436 lblaction.Caption = ""
3437 txtaction.Visible = False
3438 txtaction.Alignment = 1
3439 txtaction.MaxLength = 15
3440 txtaction.Locked = True
3441 lblf6.Caption = "F6 - Suspend Order"
3442 Call cleartext
3443 Call vieworderlist
3444 frabarcode.Enabled = True
3445 frasearch.Enabled = False
3446 fraview.Enabled = False
3447 txtbarcode.SetFocus
3448 Else
3449 lvworder.SetFocus
3450 End If
3451
3452 ElseIf lblaction.Caption = "Total Charges" Then
3453 securityprocno = 6
3454 frapassword.Visible = True
3455 txtposuser.Text = ""
3456 txtpospass.Text = ""
3457 Call enabledisable(False)
3458 txtposuser.SetFocus
3459
3460 End If
3461
3462 Exit Sub
3463
3464LogError:
3465 LogInfo "Error - " & Err.description
3466 Resume Next
3467
3468End Sub
3469
3470Sub recalltransac()
3471On Error GoTo LogError
3472
3473 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
3474 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
3475 Exit Sub
3476 End If
3477 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
3478 MsgBox "Payment was already inputted.", vbInformation, systemname
3479 Exit Sub
3480 End If
3481 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
3482 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
3483 Exit Sub
3484 End If
3485
3486 If lblmove.Visible = True Then
3487 securityprocno = 7
3488 frapassword.Visible = True
3489 txtposuser.Text = ""
3490 txtpospass.Text = ""
3491 Call enabledisable(False)
3492 txtposuser.SetFocus
3493 Exit Sub
3494
3495 ElseIf lblaction.Caption = "Choose an item." Then
3496 MsgBox "You are currently choosing an item." _
3497 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3498 txtbarcode.SetFocus
3499 Exit Sub
3500
3501 ElseIf lblaction.Caption = "Select an item to edit." Then
3502 MsgBox "You are currently selecting an item to edit." _
3503 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3504 lvworder.SetFocus
3505 Exit Sub
3506
3507 ElseIf lblaction.Caption = "Quantity" Then
3508 MsgBox "You are currently editing an item." _
3509 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3510 txtaction.SetFocus
3511 Exit Sub
3512
3513 ElseIf lblaction.Caption = "Select an item to delete." Then
3514 MsgBox "You are currently selecting an item to delete." _
3515 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3516 lvworder.SetFocus
3517 Exit Sub
3518
3519 ElseIf frapayment.Visible = True Then
3520 MsgBox "You are currently transacting a payment." _
3521 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3522 cbopaymentmode.SetFocus
3523 Exit Sub
3524
3525 ElseIf lblaction.Caption = "Suspension Tag" Then
3526 MsgBox "You are currently suspending an order." _
3527 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3528 lvworder.SetFocus
3529 Exit Sub
3530
3531 ElseIf lblaction.Caption = "Total Charges" Then
3532 MsgBox "You are currently on a transaction." _
3533 & vbCrLf & "Execute Cancel or Press ESC, before recalling an order.", vbCritical, systemname
3534 lvworder.SetFocus
3535 Exit Sub
3536
3537 End If
3538
3539 Exit Sub
3540
3541LogError:
3542 LogInfo "Error - " & Err.description
3543 Resume Next
3544End Sub
3545
3546Sub applydiscount()
3547On Error GoTo LogError
3548
3549 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
3550 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
3551 '---pls. uncomment this, for testing only ..
3552 Exit Sub
3553 '---
3554
3555 End If
3556 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
3557 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
3558 Exit Sub
3559 End If
3560
3561 If lblmove.Visible = True And Val(Format(txtcharge.Text, "###0.00")) > 0 Then
3562 securityprocno = 8
3563 frapassword.Visible = True
3564 txtposuser.Text = ""
3565 txtpospass.Text = ""
3566 Call enabledisable(False)
3567 txtposuser.SetFocus
3568 Exit Sub
3569
3570 ElseIf lblaction.Caption = "Choose an item." Then
3571 MsgBox "You are currently choosing an item.", vbCritical, systemname
3572 txtbarcode.SetFocus
3573 Exit Sub
3574
3575 ElseIf lblaction.Caption = "Select an item to edit." Then
3576 MsgBox "You are currently selecting an item to edit.", vbCritical, systemname
3577 lvworder.SetFocus
3578 Exit Sub
3579
3580 ElseIf lblaction.Caption = "Quantity" Then
3581 MsgBox "You are currently editing the quantity.", vbCritical, systemname
3582 txtaction.SetFocus
3583 Exit Sub
3584
3585 ElseIf lblaction.Caption = "Select an item to delete." Then
3586 MsgBox "You are currently selecting an item to delete.", vbCritical, systemname
3587 lvworder.SetFocus
3588 Exit Sub
3589
3590 ElseIf frapayment.Visible = True Then
3591 MsgBox "You are currently transacting a payment.", vbCritical, systemname
3592 cbopaymentmode.SetFocus
3593 Exit Sub
3594
3595 ElseIf lblaction.Caption = "Suspension Tag" Then
3596 MsgBox "You are currently suspending an order.", vbCritical, systemname
3597 lvworder.SetFocus
3598 Exit Sub
3599
3600 ElseIf frarecall.Visible = True Then
3601 MsgBox "You are currently recalling a transaction.", vbCritical, systemname
3602 lstrecall.SetFocus
3603 Exit Sub
3604
3605 ElseIf lblaction.Caption = "Total Charges" Then
3606 securityprocno = 8
3607 frapassword.Visible = True
3608 txtposuser.Text = ""
3609 txtpospass.Text = ""
3610 Call enabledisable(False)
3611 txtposuser.SetFocus
3612 Exit Sub
3613
3614 End If
3615
3616 Exit Sub
3617
3618LogError:
3619LogInfo "Error - " & Err.description
3620Resume Next
3621
3622End Sub
3623
3624Sub changequantity()
3625 LogInfo "Change Quantity Clicked"
3626
3627 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
3628 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
3629 Exit Sub
3630 End If
3631 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
3632 MsgBox "Payment was already inputted.", vbInformation, systemname
3633 Exit Sub
3634 End If
3635 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
3636 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
3637 Exit Sub
3638 End If
3639
3640 If lblmove.Visible = True Then
3641 fraquantity.Visible = True
3642 Call enabledisable(False)
3643 firstclick = 0
3644 txtquantity.Text = "1"
3645 txtquantity.SetFocus
3646 Exit Sub
3647
3648 ElseIf lblaction.Caption = "Choose an item." Then
3649 MsgBox "You are currently choosing an item.", vbCritical, systemname
3650 txtbarcode.SetFocus
3651 Exit Sub
3652
3653 ElseIf lblaction.Caption = "Select an item to edit." Then
3654 MsgBox "You are currently selecting an item to edit.", vbCritical, systemname
3655 lvworder.SetFocus
3656 Exit Sub
3657
3658 ElseIf lblaction.Caption = "Quantity" Then
3659 MsgBox "You are currently editing the quantity.", vbCritical, systemname
3660 txtaction.SetFocus
3661 Exit Sub
3662
3663 ElseIf lblaction.Caption = "Select an item to delete." Then
3664 MsgBox "You are currently selecting an item to delete.", vbCritical, systemname
3665 lvworder.SetFocus
3666 Exit Sub
3667
3668 ElseIf frapayment.Visible = True Then
3669 MsgBox "You are currently transacting a payment.", vbCritical, systemname
3670 cbopaymentmode.SetFocus
3671 Exit Sub
3672
3673 ElseIf lblaction.Caption = "Suspension Tag" Then
3674 MsgBox "You are currently suspending an order.", vbCritical, systemname
3675 lvworder.SetFocus
3676 Exit Sub
3677
3678 ElseIf frarecall.Visible = True Then
3679 MsgBox "You are currently recalling a transaction.", vbCritical, systemname
3680 lstrecall.SetFocus
3681 Exit Sub
3682
3683 ElseIf lblaction.Caption = "Total Charges" Then
3684 fraquantity.Visible = True
3685 Call enabledisable(False)
3686 firstclick = 0
3687 txtquantity.Text = "1"
3688 txtquantity.SetFocus
3689 Exit Sub
3690
3691 End If
3692End Sub
3693
3694Sub canceltransac()
3695 If Text1.Text <> "Close" Or Text2.Text <> "Ready" Then
3696 LogInfo "Cancel Transaction Abort - Please check printer and cash drawer status"
3697 MsgBox "Please check printer and cash drawer status.", vbCritical, systemname
3698 Exit Sub
3699 End If
3700 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
3701 LogInfo "Cancel Transaction Abort - Payment was already inputted."
3702 MsgBox "Payment was already inputted.", vbInformation, systemname
3703 Exit Sub
3704 End If
3705 If Val(Format(txtpayment.Text, "###0.00")) <> 0 _
3706 And Val(Format(txtpayment.Text, "###0.00")) >= Val(Format(txtpayable.Text, "###0.00")) Then
3707 LogInfo "Cancel Transaction Abort"
3708 Exit Sub
3709 End If
3710
3711 If lblmove.Visible = True Then
3712 LogInfo "Cancel Transaction Abort - lblmove is Visible"
3713 Exit Sub
3714
3715 ElseIf lblaction.Caption = "Choose an item." _
3716 And lvworder.ListItems.Count = 0 Then
3717
3718 LogInfo "Cancel Transaction OK - lblaction OK and Count is 0"
3719 lblmove.Visible = True
3720 lblaction.Visible = False
3721 lblaction.Caption = ""
3722 txtaction.Visible = False
3723 Call cleartext
3724 Call vieworderlist
3725 frabarcode.Enabled = True
3726 frasearch.Enabled = False
3727 fraview.Enabled = False
3728 txtbarcode.Text = ""
3729 txtsearch.Text = ""
3730 txtbarcode.SetFocus
3731
3732 ElseIf lblaction.Caption = "Choose an item." _
3733 And lvworder.ListItems.Count <> 0 _
3734 Or lblaction.Caption = "Select an item to edit." _
3735 Or lblaction.Caption = "Quantity" _
3736 Or lblaction.Caption = "Select an item to delete." _
3737 Or lblaction.Caption = "Suspension Tag" _
3738 Or lblaction.Caption = "Total Charges" _
3739 And frapayment.Visible = True Then
3740
3741 LogInfo "Cancel Transaction OK - lblaction OK and Count is not 0"
3742 lblaction.Caption = "Total Charges"
3743 lblf3.Caption = "F3 - Delete Order"
3744 lblf6.Caption = "F6 - Suspend Order"
3745 txtaction.Visible = True
3746 txtaction.Locked = True
3747 txtaction.Alignment = 1
3748 txtaction.MaxLength = 15
3749 txtaction.Text = txtpayable.Text
3750 frachoose.Visible = True
3751 lblf10.Visible = True
3752 frapayment.Visible = False
3753 frarecall.Visible = False
3754 Call vieworderlist
3755 frabarcode.Enabled = True
3756 frasearch.Enabled = False
3757 fraview.Enabled = False
3758 txtbarcode.Text = ""
3759 txtsearch.Text = ""
3760 txtbarcode.SetFocus
3761
3762 ElseIf frapayment.Visible = True _
3763 And frachoosepayment.Visible = False Then
3764
3765 LogInfo "Cancel Transaction OK - frapayment is visible"
3766 frachoosepayment.Visible = True
3767 fracash.Visible = False
3768 fracard.Visible = False
3769 fraconsumablecharge.Visible = False
3770 fracoupon.Visible = False
3771 fracustomer.Visible = False
3772 Call clearpayment
3773 cbopaymentmode.Text = ""
3774 cbopaymentmode.SetFocus
3775
3776 ElseIf frarecall.Visible = True Then
3777
3778 LogInfo "Cancel Transaction OK - frarecall is visible"
3779 lstrecall.ListItems.Clear
3780 frachoose.Visible = True
3781 lblf10.Visible = True
3782 frapayment.Visible = False
3783 frarecall.Visible = False
3784 txtbarcode.SetFocus
3785
3786 ElseIf lblaction.Caption = "Total Charges" Then
3787 If Val(Format(txtpayment.Text, "###0.00")) > 0 Then
3788
3789 LogInfo "Cancel Transaction Abort - Payment has transacted"
3790 MsgBox "Cannot cancel transaction." _
3791 & vbCrLf & "A payment has been transacted." _
3792 & vbCrLf & "Void payment first before cancelling the transaction." _
3793 & vbCrLf & "Contact your administrator or supervisor.", vbCritical, systemname
3794 lvworder.SetFocus
3795 Exit Sub
3796 End If
3797
3798 LogInfo "Cancel Transaction OK - Payment has still 0"
3799 securityprocno = 0
3800 frapassword.Visible = True
3801 txtposuser.Text = ""
3802 txtpospass.Text = ""
3803 Call enabledisable(False)
3804 txtposuser.SetFocus
3805
3806 End If
3807End Sub
3808
3809Sub exitpos()
3810 If frapayment.Visible = True Then
3811 MsgBox "You are currently transacting a payment." _
3812 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3813 cbopaymentmode.SetFocus
3814 Exit Sub
3815
3816 ElseIf frarecall.Visible = True Then
3817 MsgBox "You are currently recalling a transaction." _
3818 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3819 lstrecall.SetFocus
3820 Exit Sub
3821
3822 ElseIf lblaction.Visible = True Then
3823 If lblaction.Caption = "Choose an item." Then
3824 MsgBox "You are currently choosing an item." _
3825 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3826 txtbarcode.SetFocus
3827 Exit Sub
3828
3829 ElseIf lblaction.Caption = "Select an item to edit." Then
3830 MsgBox "You are currently selecting an item to edit." _
3831 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3832 lvworder.SetFocus
3833 Exit Sub
3834
3835 ElseIf lblaction.Caption = "Quantity" Then
3836 MsgBox "You are currently editing an item." _
3837 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3838 txtaction.SetFocus
3839 Exit Sub
3840
3841 ElseIf lblaction.Caption = "Select an item to delete." Then
3842 MsgBox "You are currently selecting an item to delete." _
3843 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3844 lvworder.SetFocus
3845 Exit Sub
3846
3847 ElseIf lblaction.Caption = "Suspension Tag" Then
3848 MsgBox "You are currently suspending an order." _
3849 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3850 lvworder.SetFocus
3851 Exit Sub
3852
3853 ElseIf lblaction.Caption = "Total Charges" Then
3854 MsgBox "You are currently doing a transaction." _
3855 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
3856 Exit Sub
3857
3858 End If
3859 End If
3860 If MsgBox("Exit " & systemname & "?", vbInformation + vbYesNo, systemname) = vbYes Then
3861 mainform.Timer1.Enabled = True
3862 LogInfo "Exitpos confirmed by user"
3863 Unload Me
3864 End If
3865End Sub
3866
3867Private Sub cmdlookup_Click()
3868 fracustomer.Visible = True
3869 Call setbuttons(Me, View)
3870 mode = View
3871 Call enable
3872 Call loadstatus
3873 Call cleartextcustomer
3874 Call loadlistcustomer(False)
3875 Call loadtext(False)
3876End Sub
3877
3878Private Sub cmdadd_Click()
3879 If cmdadd.Caption = "&Add" Then
3880 Call setbuttons(Me, Add)
3881 mode = Add
3882 Call disable
3883 Call cleartextcustomer
3884 txtcustomername.SetFocus
3885 ElseIf cmdadd.Caption = "&Save" Then
3886 If txtcustomername.Text = "" Or cbostatus.Text = "" Then
3887 MsgBox "Input required field.", vbCritical, systemname
3888 txtcustomername.SetFocus
3889 Exit Sub
3890 End If
3891 Call modmain.rsConnection(rscustomer, "SELECT * FROM tbl_M_customer " _
3892 & "WHERE customername = '" & txtcustomername.Text & "'")
3893 If rscustomer.EOF = True Then
3894 rscustomer.Close
3895
3896GET_PRIMARYKEY:
3897 Call modmain.rsConnection(rsidctr, "SELECT * FROM tbl_M_syscon " _
3898 & "WHERE modulename = 'CUSTOMER'")
3899 customerid = Val(rsidctr!lastnumber) + 1
3900 rsidctr.Close
3901
3902 Call modmain.rsConnection(rscustomer, "SELECT * FROM tbl_M_customer " _
3903 & "WHERE customerid = '" & customerid & "'")
3904 If Not rscustomer.EOF = True Then
3905 rscustomer.Close
3906 GoTo GET_PRIMARYKEY
3907 End If
3908
3909 conn.Execute "INSERT INTO tbl_M_customer(customerid,customername,statusid," _
3910 & "userid,lupdatetime,updatests) VALUES('" & customerid _
3911 & "','" & UCase(txtcustomername.Text) & "','" & cbostatus.BoundText _
3912 & "','" & userloginid & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
3913 & "','A')"
3914
3915 conn.Execute "UPDATE tbl_M_syscon SET lastnumber = '" & customerid & "' " _
3916 & "WHERE modulename = 'CUSTOMER'"
3917
3918 MsgBox "Successfully added to the database.", vbInformation, systemname
3919 Call setbuttons(Me, View)
3920 mode = View
3921 Call enable
3922 Call loadlistcustomer(False)
3923 Else
3924 MsgBox "Customer name already exists.", vbCritical, systemname
3925 rscustomer.Close
3926 txtcustomername.SetFocus
3927 End If
3928 End If
3929End Sub
3930
3931Private Sub cmdedit_Click()
3932 If cmdedit.Caption = "&Edit" Then
3933 If lvwcustomer.ListItems.Count = 0 Then
3934 MsgBox "No record to edit.", vbCritical, systemname
3935 Exit Sub
3936 End If
3937 If txtcustomername.Text = "" Then
3938 MsgBox "Choose customer to modify.", vbCritical, systemname
3939 Exit Sub
3940 End If
3941 Call setbuttons(Me, Edit)
3942 mode = Edit
3943 Call disable
3944 customername = txtcustomername.Text
3945 txtcustomername.SetFocus
3946 ElseIf cmdedit.Caption = "&Save" Then
3947 If txtcustomername.Text = "" Or cbostatus.Text = "" Then
3948 MsgBox "Input required field.", vbCritical, systemname
3949 txtcustomername.SetFocus
3950 Exit Sub
3951 End If
3952 If Trim(UCase(customername)) = Trim(UCase(txtcustomername.Text)) Then
3953
3954 conn.Execute "UPDATE tbl_M_customer " _
3955 & "SET customername = '" & UCase(txtcustomername.Text) & "'," _
3956 & "statusid = '" & cbostatus.BoundText & "'," _
3957 & "userid = '" & userloginid & "'," _
3958 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
3959 & "updatests = 'U' WHERE customerid = '" & customerid & "'"
3960
3961 MsgBox "Successfully updated in the database.", vbInformation, systemname
3962 Call setbuttons(Me, View)
3963 mode = View
3964 Call enable
3965 Call loadlistcustomer(False)
3966 Else
3967 Call modmain.rsConnection(rscustomer, "SELECT * FROM tbl_M_customer " _
3968 & "WHERE customername = '" & txtcustomername.Text & "'")
3969 If rscustomer.EOF = True Then
3970 rscustomer.Close
3971
3972 conn.Execute "UPDATE tbl_M_customer " _
3973 & "SET customername = '" & UCase(txtcustomername.Text) & "'," _
3974 & "statusid = '" & cbostatus.BoundText & "'," _
3975 & "userid = '" & userloginid & "'," _
3976 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
3977 & "updatests = 'U' WHERE customerid = '" & customerid & "'"
3978
3979 MsgBox "Successfully updated in the database.", vbInformation, systemname
3980 Call setbuttons(Me, View)
3981 mode = View
3982 Call enable
3983 Call loadlistcustomer(False)
3984 Else
3985 MsgBox "Customer name already exists.", vbCritical, systemname
3986 rscustomer.Close
3987 txtcustomername.SetFocus
3988 End If
3989 End If
3990 End If
3991End Sub
3992
3993Private Sub cmdclose_Click()
3994 If cmdclose.Caption = "&Cancel" Then
3995 Call setbuttons(Me, View)
3996 Call enable
3997 Call cleartextcustomer
3998 Call loadlistcustomer(False)
3999 Call loadtext(False)
4000 ElseIf cmdclose.Caption = "&Close" Then
4001 Call loadcustomer
4002 fracustomer.Visible = False
4003 End If
4004End Sub
4005
4006Private Sub lvwcustomer_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
4007 If lvwcustomer.Sorted And _
4008 ColumnHeader.Index - 1 = lvwcustomer.SortKey Then
4009 lvwcustomer.SortOrder = 1 - lvwcustomer.SortOrder
4010 Else
4011 lvwcustomer.SortOrder = lvwAscending
4012 lvwcustomer.SortKey = ColumnHeader.Index - 1
4013 End If
4014 lvwcustomer.Sorted = True
4015End Sub
4016
4017Private Sub lvwcustomer_Click()
4018 If lvwcustomer.ListItems.Count = 0 Then
4019 MsgBox "No records inputted.", vbCritical, outletname
4020 cmdadd.SetFocus
4021 Exit Sub
4022 End If
4023 Call loadtext(True)
4024 txtsearchcustomer.Text = ""
4025End Sub
4026
4027Private Sub lvwcustomer_KeyUp(KeyCode As Integer, Shift As Integer)
4028 Call lvwcustomer_Click
4029End Sub
4030
4031Private Sub txtsearchcustomer_KeyPress(KeyAscii As Integer)
4032 KeyAscii = entryfields(KeyAscii)
4033End Sub
4034
4035Private Sub txtsearchcustomer_Change()
4036 If txtsearchcustomer.Text = "" Then
4037 Call loadlistcustomer(False)
4038 Else
4039 Call loadlistcustomer(True)
4040 End If
4041End Sub
4042
4043Private Sub txtcustomername_LostFocus()
4044 If Not Len(txtcustomername.Text) = 0 Then
4045 txtcustomername.Text = UCase(txtcustomername.Text)
4046 End If
4047End Sub
4048
4049Private Sub txtcustomername_GotFocus()
4050 Hilighttext txtcustomername
4051End Sub
4052
4053Private Sub txtcustomername_KeyPress(KeyAscii As Integer)
4054 KeyAscii = entryfields(KeyAscii)
4055End Sub
4056
4057Private Sub txtdiscountname_LostFocus()
4058 If Not Len(txtdiscountname.Text) = 0 Then
4059 txtdiscountname.Text = UCase(txtdiscountname.Text)
4060 End If
4061End Sub
4062
4063Private Sub txtdiscountname_GotFocus()
4064 Hilighttext txtdiscountname
4065End Sub
4066
4067Private Sub txtdiscountname_KeyPress(KeyAscii As Integer)
4068 KeyAscii = entryfields(KeyAscii)
4069End Sub
4070
4071Private Sub txtdiscountrefno_GotFocus()
4072 Hilighttext txtdiscountrefno
4073End Sub
4074
4075Private Sub txtdiscountrefno_KeyPress(KeyAscii As Integer)
4076 KeyAscii = entryfields(KeyAscii)
4077End Sub
4078
4079Private Sub txtposuser_GotFocus()
4080 Hilighttext txtposuser
4081End Sub
4082
4083Private Sub txtposuser_KeyPress(KeyAscii As Integer)
4084 KeyAscii = usernamepassword(KeyAscii)
4085End Sub
4086
4087Private Sub txtpospass_GotFocus()
4088 Hilighttext txtpospass
4089End Sub
4090
4091Private Sub txtpospass_KeyPress(KeyAscii As Integer)
4092 If KeyAscii = 13 Then
4093 Call cmdpassok_Click
4094 Else
4095 KeyAscii = usernamepassword(KeyAscii)
4096 End If
4097End Sub
4098
4099'*************'
4100'SUB FUNCTIONS'
4101'*************'
4102
4103Sub cleartextcustomer()
4104 customerid = ""
4105 txtcustomername.Text = ""
4106 cbostatus.Text = ""
4107 txtsearchcustomer.Text = ""
4108 customerDiscountName = ""
4109 customerDiscountID = ""
4110End Sub
4111
4112Sub disable()
4113 frasearchcustomer.Enabled = False
4114 fralist.Enabled = False
4115 fracustomerinfo.Enabled = True
4116End Sub
4117
4118Sub enable()
4119 frasearchcustomer.Enabled = True
4120 fralist.Enabled = True
4121 fracustomerinfo.Enabled = False
4122End Sub
4123
4124Sub enabledisable(bol As Boolean)
4125 cmdpriceinquiry.Enabled = bol
4126 cmdshiftend.Enabled = bol
4127 cmdvoid.Enabled = bol
4128 cmdreprint.Enabled = bol
4129 cbobagger.Enabled = bol
4130 lblf10.Enabled = bol
4131 frachoose.Enabled = bol
4132 frabarcode.Enabled = bol
4133 frastock.Enabled = bol
4134End Sub
4135
4136Sub loadstatus()
4137 Set rsstatus = New ADODB.Recordset
4138 rsstatus.Open "SELECT * FROM tbl_M_status ORDER BY statusid DESC", conn, adOpenStatic
4139 Bind_ListToRecordset Me.cbostatus, rsstatus, "statusid", "status"
4140End Sub
4141
4142Sub loaddiscount()
4143 Set rsdiscount = New ADODB.Recordset
4144 rsdiscount.Open "SELECT * FROM tbl_M_discountinfo " _
4145 & "WHERE statusid = 1 and pcardflag = '0' ORDER BY discountinfo", conn, adOpenStatic
4146 Bind_ListToRecordset Me.cbodiscount, rsdiscount, "discountinfoid", "discountinfo"
4147End Sub
4148
4149Sub loadlistcustomer(loadlistflag As Boolean)
4150
4151 Screen.MousePointer = vbHourglass
4152
4153 lvwcustomer.ListItems.Clear
4154
4155 If loadlistflag = False Then
4156 Call modmain.rsConnection(rsloadlistcustomer, "SELECT * FROM tbl_M_customer " _
4157 & "ORDER BY customername")
4158 Else
4159 Call modmain.rsConnection(rsloadlistcustomer, "SELECT * FROM tbl_M_customer " _
4160 & "WHERE customername LIKE '" & txtsearchcustomer.Text & "%' " _
4161 & "ORDER BY customername")
4162 End If
4163 With rsloadlistcustomer
4164 If .EOF = True Then
4165 MsgBox "No record found.", vbCritical, systemname
4166 rsloadlistcustomer.Close
4167 txtsearchcustomer.Text = ""
4168 Else
4169 For ctrcustomer = 1 To .RecordCount
4170 Set lstitem = lvwcustomer.ListItems.Add(, , !customerid)
4171 lstitem.SubItems(1) = UCase(!customername)
4172 statusid = !statusid
4173 If statusid = 1 Then
4174 lstitem.SubItems(2) = "ACTIVE"
4175 Else
4176 lstitem.SubItems(2) = "INACTIVE"
4177 End If
4178
4179 .MoveNext
4180 Next
4181 rsloadlistcustomer.Close
4182 End If
4183 End With
4184
4185 Screen.MousePointer = vbDefault
4186
4187End Sub
4188
4189Sub loadtext(loadtextflag As Boolean)
4190 If loadtextflag = False Then
4191 Call modmain.rsConnection(rsloadtext, "SELECT * FROM tbl_M_customer " _
4192 & "ORDER BY customerid")
4193 Else
4194 Call modmain.rsConnection(rsloadtext, "SELECT * FROM tbl_M_customer " _
4195 & "WHERE customerid = '" & lvwcustomer.SelectedItem & "'")
4196 End If
4197 With rsloadtext
4198 If Not .EOF Then
4199 customerid = !customerid
4200 txtcustomername.Text = UCase(!customername)
4201 cbostatus.BoundText = !statusid
4202 End If
4203 .Close
4204 End With
4205End Sub
4206
4207Private Sub cmd0_Click()
4208 If firstclick = 0 Then
4209 txtquantity.Text = "0"
4210 firstclick = 1
4211 Else
4212 txtquantity.Text = Val(txtquantity.Text & "0")
4213 End If
4214 txtquantity.SetFocus
4215End Sub
4216
4217Private Sub cmd1_Click()
4218 If firstclick = 0 Then
4219 txtquantity.Text = "1"
4220 firstclick = 1
4221 Else
4222 txtquantity.Text = Val(txtquantity.Text & "1")
4223 End If
4224 txtquantity.SetFocus
4225End Sub
4226
4227Private Sub cmd2_Click()
4228 If firstclick = 0 Then
4229 txtquantity.Text = "2"
4230 firstclick = 1
4231 Else
4232 txtquantity.Text = Val(txtquantity.Text & "2")
4233 End If
4234 txtquantity.SetFocus
4235End Sub
4236
4237Private Sub cmd3_Click()
4238 If firstclick = 0 Then
4239 txtquantity.Text = "3"
4240 firstclick = 1
4241 Else
4242 txtquantity.Text = Val(txtquantity.Text & "3")
4243 End If
4244 txtquantity.SetFocus
4245End Sub
4246
4247Private Sub cmd4_Click()
4248 If firstclick = 0 Then
4249 txtquantity.Text = "4"
4250 firstclick = 1
4251 Else
4252 txtquantity.Text = Val(txtquantity.Text & "4")
4253 End If
4254 txtquantity.SetFocus
4255End Sub
4256
4257Private Sub cmd5_Click()
4258 If firstclick = 0 Then
4259 txtquantity.Text = "5"
4260 firstclick = 1
4261 Else
4262 txtquantity.Text = Val(txtquantity.Text & "5")
4263 End If
4264 txtquantity.SetFocus
4265End Sub
4266
4267Private Sub cmd6_Click()
4268 If firstclick = 0 Then
4269 txtquantity.Text = "6"
4270 firstclick = 1
4271 Else
4272 txtquantity.Text = Val(txtquantity.Text & "6")
4273 End If
4274 txtquantity.SetFocus
4275End Sub
4276
4277Private Sub cmd7_Click()
4278 If firstclick = 0 Then
4279 txtquantity.Text = "7"
4280 firstclick = 1
4281 Else
4282 txtquantity.Text = Val(txtquantity.Text & "7")
4283 End If
4284 txtquantity.SetFocus
4285End Sub
4286
4287Private Sub cmd8_Click()
4288 If firstclick = 0 Then
4289 txtquantity.Text = "8"
4290 firstclick = 1
4291 Else
4292 txtquantity.Text = Val(txtquantity.Text & "8")
4293 End If
4294 txtquantity.SetFocus
4295End Sub
4296
4297Private Sub cmd9_Click()
4298 If firstclick = 0 Then
4299 txtquantity.Text = "9"
4300 firstclick = 1
4301 Else
4302 txtquantity.Text = Val(txtquantity.Text & "9")
4303 End If
4304 txtquantity.SetFocus
4305End Sub
4306
4307Private Sub cmdclear_Click()
4308 firstclick = 0
4309 txtquantity.Text = "1"
4310 txtquantity.SetFocus
4311End Sub
4312
4313Private Sub cmdcancelquantity_Click()
4314 fraquantity.Visible = False
4315 Call enabledisable(True)
4316 firstclick = 0
4317 txtquantity.Text = "1"
4318 txtbarcode.SetFocus
4319End Sub
4320
4321Private Sub txtquantity_GotFocus()
4322 Hilighttext txtquantity
4323End Sub
4324
4325Private Sub txtquantity_Click()
4326 Hilighttext txtquantity
4327End Sub
4328
4329Private Sub txtquantity_KeyPress(KeyAscii As Integer)
4330 If KeyAscii = 13 Then
4331 If txtquantity.Text = "" Or Val(Format(txtquantity.Text, "###0.00")) <= 0 Then
4332 MsgBox "Input quantity.", vbCritical, systemname
4333 txtquantity.SetFocus
4334 Exit Sub
4335 End If
4336
4337 firstclick = 0
4338
4339 fraquantity.Visible = False
4340 Call enabledisable(True)
4341 txtbarcode.SetFocus
4342
4343 ElseIf KeyAscii = 8 Then
4344 Call cmdcancelquantity_Click
4345
4346 Else
4347 firstclick = 1
4348 KeyAscii = numbersonly(KeyAscii)
4349 End If
4350End Sub
4351
4352Private Sub cmddiscountclose_Click()
4353 fradiscount.Visible = False
4354 Call enabledisable(True)
4355 Call cleardiscount
4356 txtbarcode.SetFocus
4357End Sub
4358
4359
4360Private Sub DiscountPcard()
4361On Error GoTo LogError
4362
4363Dim strsql As String
4364Dim grossprice As Double
4365Dim rspcategory As New ADODB.Recordset
4366
4367 If CardnumberExist = False Then
4368 MsgBox "Privilege Card Number does not exist in Master File", vbCritical + vbOKOnly
4369 txtPCardNo.Enabled = True
4370 txtPCardNo.SetFocus
4371 Exit Sub
4372 End If
4373 If Val(Format(txtcharge.Text, "###0.00")) <= 0 Then
4374 MsgBox "Cannot set discount." & vbCrLf _
4375 & "No charges accumulated.", vbCritical, systemname
4376 cmddiscountclose.SetFocus
4377 Exit Sub
4378 End If
4379
4380 strsql = "SELECT * FROM tbl_M_pcardmain WHERE pcardnumber = '" & txtPCardNo.Text & "' "
4381 Call modmain.rsConnection(rspos, strsql)
4382
4383 pcardnumber = rspos!pcardnumber
4384 pctypeid = rspos!pctype
4385
4386
4387 Call modmain.rsConnection(rsdiscount, "SELECT a.stockid, b.prodtypeid, a.finalprice , a.vatableitem FROM tbl_T_orderdetail a inner join vw_stocklist b on " _
4388 & "a.stockid = b.stockid WHERE a.transacno = '" & tempbillno & "'")
4389 If rsdiscount.EOF Then
4390 MsgBox "Invalid Transaction !", vbCritical + vbOKOnly
4391 Exit Sub
4392 End If
4393 discamount = 0
4394 grossprice = 0
4395 Do While Not rsdiscount.EOF
4396 stockid = rsdiscount!stockid
4397 prodtypeid = rsdiscount!prodtypeid
4398 'finalprice = rsdiscount!finalprice
4399
4400 Call modmain.rsConnection(rspcategory, "SELECT a.discountinfoid, b.discountrate, a.discountflag, a.pointsflag FROM tbl_M_pcardcategory a inner join tbl_M_discountinfo b on " _
4401 & "a.discountinfoid = b.discountinfoid WHERE a.pctypeid = '" & pctypeid & "' and prodtypeID = '" & prodtypeid & "'")
4402 If rspcategory.EOF Then
4403 MsgBox "Invalid Discount code !", vbCritical + vbOKOnly
4404 Exit Sub
4405 End If
4406 discinfoid = rspcategory!discountinfoid
4407 discountflag = rspcategory!discountflag
4408 If discountflag = 1 Then
4409 discrate = Val(rspcategory!discountrate) / 100
4410 If Val(rsdiscount!vatableitem) = 1 Then
4411 vatlessprice = Val(Format(rsdiscount!finalprice, "###0.00")) / Val(1 + vatrate)
4412 Else
4413 vatlessprice = Format(rsdiscount!finalprice, "###0.00")
4414 End If
4415 discamount = discamount + Val(Format(vatlessprice, "###0.00")) * Val(discrate)
4416 End If
4417 grossprice = grossprice + rsdiscount!finalprice
4418
4419 rsdiscount.MoveNext
4420 Loop
4421 rsdiscount.Close
4422
4423 conn.Execute "UPDATE tbl_T_chargesdiscount " _
4424 & "SET userid = '" & userloginid & "'," _
4425 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4426 & "updatests = 'D' " _
4427 & "WHERE transacno = '" & tempbillno & "'"
4428
4429 conn.Execute "INSERT INTO tbl_T_chargesdiscount(transacno,discountinfoid,discount," _
4430 & "discountamount,userid,lupdatetime,updatests) VALUES('" & tempbillno _
4431 & "','" & discinfoid & "','" & discrate & "','" & Format(discamount, "###0.00") _
4432 & "','" & userloginid & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
4433 & "','A')"
4434
4435 txtdiscount.Text = Format(discamount, "#,##0.00")
4436
4437 Call loadpaymentmade
4438 'fradiscount.Visible = False
4439 Call enabledisable(True)
4440 MsgBox "Successfully set discount rate.", vbInformation, systemname
4441 Call cleardiscount
4442 txtbarcode.SetFocus
4443
4444 Exit Sub
4445
4446LogError:
4447 LogInfo "Error - " & Err.description
4448 Resume Next
4449End Sub
4450
4451
4452Private Sub cmddiscountok_Click()
4453Dim vatexempt As Integer
4454 Dim vatableamount As Double
4455 Dim taxamount As Double
4456 Dim temppayableamount As Double
4457
4458 Dim rsdisc As New ADODB.Recordset
4459
4460 temppayableamount = 0
4461 vatableamount = 0
4462 totalpwddiscount = 0
4463 totalpayable = 0
4464 totalvatless = 0
4465 totalvatlesspricewithdiscount = 0
4466 totaltax = 0
4467 totalVatable = 0
4468 charges = 0
4469 isPWD = False
4470 isSeniorCitizen = False
4471
4472
4473 If Val(Format(txtcharge.Text, "###0.00")) <= 0 Then
4474 MsgBox "Cannot set discount." & vbCrLf _
4475 & "No charges accumulated.", vbCritical, systemname
4476 cmddiscountclose.SetFocus
4477 Exit Sub
4478 End If
4479 If txtdiscountname.Text = "" Or txtdiscountrefno.Text = "" Then
4480 MsgBox "Input discount details.", vbCritical, systemname
4481 txtdiscountname.SetFocus
4482 Exit Sub
4483 End If
4484
4485 customerDiscountName = txtdiscountname.Text
4486 customerDiscountID = txtdiscountrefno.Text
4487
4488 Call modmain.rsConnection(rsdisc, "SELECT * FROM tbl_M_discountinfo " _
4489 & "WHERE discountinfoid = '" & cbodiscount.BoundText & "'")
4490 discrate = Val(rsdisc!discountrate) / 100
4491 vatexempt = Val(rsdisc!vatexempt)
4492 rsdisc.Close
4493
4494 'determine if senior citizen or pwd discount
4495 If cbodiscount.BoundText = 1 Then
4496 isSeniorCitizen = True
4497 ElseIf cbodiscount.BoundText = 16 Then
4498 isPWD = True
4499 End If
4500
4501
4502 If isPWD Then
4503
4504 discamount = 0
4505 charges = 0
4506 Call modmain.rsConnection(rsdiscount, "SELECT * FROM tbl_T_orderdetail " _
4507 & "WHERE transacno = '" & tempbillno & "'")
4508 For ctr = 1 To rsdiscount.RecordCount
4509 charges = charges + Format(rsdiscount!finalprice, "###0.00")
4510
4511 stockid = rsdiscount!stockid
4512 If Val(rsdiscount!vatableitem) = 1 Then 'if taxable
4513
4514 vatlessprice = Val(Format(rsdiscount!finalprice, "###0.00")) / Val(1 + vatrate)
4515 Else
4516 vatlessprice = Format(rsdiscount!finalprice, "###0.00")
4517 End If
4518
4519 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
4520 & "WHERE stockid = '" & stockid & "' " _
4521 & "AND uom = '" & rsdiscount!uom & "'")
4522
4523 If rsstocklib!seniorcitizen = 1 Then '----------if senior citizen, applicable sa PWD
4524 discamount = Val(Format(vatlessprice, "###0.00")) * discrate
4525 vatableamount = vatlessprice - discamount
4526 totalvatlesspricewithdiscount = totalvatlesspricewithdiscount + Val(Format(vatableamount, "###0.00"))
4527 taxamount = vatableamount * vatrate
4528 totaltax = totaltax + taxamount
4529 temppayableamount = vatableamount + taxamount
4530 totalpayable = totalpayable + temppayableamount
4531 '--- Added RHV 08/17/2011
4532 If rsstocklib!prodtypeid = 10 Then '--- product type is medicine
4533 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00"))
4534 Else
4535 'discamount = Val(discamount) + Val(Format(vatlessprice, "###0.00"))
4536 '------------------
4537 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00")) * Val(discrate)
4538 End If
4539 Else 'if no discount
4540
4541 taxamount = taxamount + vatlessprice * vatrate
4542 totaltax = totaltax + taxamount
4543 totalpayable = totalpayable + Format(rsdiscount!finalprice, "###0.00")
4544 totalvatless = totalvatless + vatlessprice
4545 End If
4546
4547 '----addition August 11, 2012
4548 Dim discountedvat As Double
4549
4550 discountedvat = Format(rsdiscount!sellingprice, "###0.00") - Format(vatlessprice, "###0.00")
4551 Dim discvat As Double
4552 discvat = Format(discountedvat * 0.2, "###0.00")
4553
4554 discamount = discamount + discvat
4555 discamount = Format(discamount, "###0.00")
4556 conn.Execute "UPDATE tbl_T_orderdetail " _
4557 & "SET discountamount = '" & discamount & "'," _
4558 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'" _
4559 & "WHERE transacno = '" & tempbillno & "'"
4560
4561 rsstocklib.Close
4562 discountedvat = 0
4563 discvat = 0
4564
4565 discamount = 0
4566 vatableamount = 0
4567 taxamount = 0
4568 temppayableamount = 0
4569
4570
4571
4572 rsdiscount.MoveNext
4573
4574
4575 Next
4576 rsdiscount.Close
4577
4578
4579 totalVatable = totalvatless + totalvatlesspricewithdiscount 'AMOUNT
4580 ' discamounttotal = Val(Format(discamounttotal, "###0.00")) 'PWD DISCOUNT
4581
4582
4583 charges = Val(Format(charges, "###0.00")) 'CHARGES
4584
4585 totalpayable = Val(Format(totalpayable, "###0.00")) ' TOTAL PAYABLE
4586
4587 '------revised Aug 10, 2012
4588 discamounttotal = charges - totalpayable
4589 discamounttotal = Val(Format(discamounttotal, "###0.00")) 'PWD DISCOUNT
4590
4591 totaltax = Val(Format(totaltax, "###0.00")) 'TAX
4592
4593 txtdiscount.Text = Format(discamounttotal, "#,##0.00")
4594 txtcharge.Text = Format(charges, "#,##0.00")
4595 txtpayable.Text = Format(totalpayable, "#,##0.00")
4596 txtaction.Text = Format(totalpayable, "#,##0.00")
4597 txtvat.Text = Format(totaltax, "#,##0.00")
4598 txtvatlessprice.Text = Format(totalVatable, "#,##0.00")
4599
4600 discamount = Val(Format(discamounttotal, "###0.00"))
4601
4602
4603 ElseIf isSeniorCitizen Then
4604 discamount = 0
4605 discamounttotal = 0
4606 vatlessprice = 0
4607 totalvatlessprice = 0
4608 Call modmain.rsConnection(rsdiscount, "SELECT * FROM tbl_T_orderdetail " _
4609 & "WHERE transacno = '" & tempbillno & "'")
4610 For ctr = 1 To rsdiscount.RecordCount
4611
4612 stockid = rsdiscount!stockid
4613
4614 If Val(rsdiscount!vatableitem) = 1 Then
4615 vatlessprice = Val(Format(rsdiscount!finalprice, "###0.00")) / Val(1 + vatrate)
4616 Else
4617 vatlessprice = Format(rsdiscount!finalprice, "###0.00")
4618 End If
4619
4620 Call modmain.rsConnection(rsstocklib, "SELECT * FROM vw_stocklist " _
4621 & "WHERE stockid = '" & stockid & "' " _
4622 & "AND uom = '" & rsdiscount!uom & "'")
4623
4624 If rsstocklib!seniorcitizen = 1 Then
4625
4626 discamount = Val(discamount) + Val(Format(vatlessprice, "###0.00"))
4627 totalvatlessprice = totalvatlessprice + Val(Format(vatlessprice, "###0.00"))
4628 '--- Added RHV 08/17/2011
4629
4630 If rsstocklib!prodtypeid = 10 Then
4631 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00")) * 0.2
4632 Else
4633 'discamount = Val(discamount) + Val(Format(vatlessprice, "###0.00"))
4634 discamounttotal = discamounttotal + Val(Format(discamount, "###0.00")) * Val(discrate)
4635 End If
4636 '---
4637 Else
4638 totalvatlessprice = totalvatlessprice + Format(rsdiscount!finalprice, "###0.00")
4639 End If
4640
4641 '----addition August 11, 2012
4642 conn.Execute "UPDATE tbl_T_orderdetail " _
4643 & "SET discountamount = '" & discamount & "'," _
4644 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'" _
4645 & "WHERE transacno = '" & tempbillno & "'"
4646
4647 rsstocklib.Close
4648
4649
4650 discamount = 0
4651 rsdiscount.MoveNext
4652 Next
4653 rsdiscount.Close
4654 discamount = Val(Format(discamounttotal, "###0.00"))
4655
4656 txtvatlessprice.Text = Format(totalvatlessprice, "#,##0.00")
4657
4658 Else
4659 discamount = Val(Format(txtcharge.Text, "###0.00")) * Val(discrate)
4660 '----addition August 11, 2012
4661 conn.Execute "UPDATE tbl_T_orderdetail " _
4662 & "SET discountamount = '" & discamount & "'," _
4663 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'" _
4664 & "WHERE transacno = '" & tempbillno & "'"
4665 End If
4666
4667 conn.Execute "UPDATE tbl_T_chargesdiscount " _
4668 & "SET userid = '" & userloginid & "'," _
4669 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4670 & "updatests = 'D' " _
4671 & "WHERE transacno = '" & tempbillno & "'"
4672
4673 conn.Execute "INSERT INTO tbl_T_chargesdiscount(transacno,discountinfoid,discount," _
4674 & "discountamount,userid,lupdatetime,updatests,vatlessprice) VALUES('" & tempbillno _
4675 & "','" & cbodiscount.BoundText & "','" & discrate & "','" & Format(discamount, "###0.00") _
4676 & "','" & userloginid & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
4677 & "','A', '" & totalvatlessprice & "' )"
4678
4679
4680 Call loadpaymentmade
4681
4682 fradiscount.Visible = False
4683 Call enabledisable(True)
4684 MsgBox "Successfully set discount rate.", vbInformation, systemname
4685 Call cleardiscount
4686 Call inputpayment
4687 'txtbarcode.SetFocus
4688 cbopaymentmode.SetFocus
4689
4690
4691
4692End Sub
4693
4694Private Sub cmddiscountremove_Click()
4695 If Val(Format(txtdiscount.Text, "###0.00")) > 0 Then
4696 conn.Execute "UPDATE tbl_T_chargesdiscount " _
4697 & "SET userid = '" & userloginid & "'," _
4698 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4699 & "updatests = 'D' " _
4700 & "WHERE transacno = '" & tempbillno & "'"
4701 Call loadpaymentmade
4702 End If
4703 MsgBox "Successfully remove discount rate set.", vbInformation, systemname
4704 Call cleardiscount
4705 txtdiscount.Text = "0.00"
4706End Sub
4707
4708Private Sub cmdpassok_Click()
4709 Call modmain.rsConnection(rslogin, "SELECT * FROM tbl_M_user " _
4710 & "WHERE username = '" & txtposuser.Text & "' AND statusid = 1")
4711 If rslogin.EOF = True Then
4712 MsgBox "Username does not exist.", vbCritical, systemname
4713 rslogin.Close
4714 txtposuser.SetFocus
4715 Exit Sub
4716 Else
4717 encryptdecrypt = modencryptdecrypt.DECRYPT(rslogin!userpassword, Len(rslogin!userpassword))
4718 posallowedid = rslogin!userid
4719
4720 If txtpospass.Text <> encryptdecrypt Then
4721 MsgBox "Invalid password!!!", vbCritical, systemname
4722 rslogin.Close
4723 txtpospass.SetFocus
4724 Exit Sub
4725 Else
4726 posaccesslevelid = rslogin!accesslevelid
4727 rslogin.Close
4728
4729 Call modmain.rsConnection(rsaccesslevel, "SELECT accesslevelid,statusid,posf " _
4730 & "FROM tbl_M_tool WHERE accesslevelid = '" & posaccesslevelid & "' " _
4731 & "AND statusid = 1 AND posf = 1")
4732 If rsaccesslevel.EOF = True Then
4733 MsgBox "You are not allowed to do changes in this module.", vbCritical, systemname
4734 cmdpasscancel.SetFocus
4735 Else
4736 frapassword.Visible = False
4737
4738 Select Case securityprocno
4739 Case 0
4740 Call enabledisable(True)
4741 If MsgBox("Are you sure you want to cancel this transaction?", vbInformation + vbYesNo, systemname) = vbYes Then
4742
4743 conn.Execute "DELETE FROM tbl_T_orderdetail " _
4744 & "WHERE transacno = '" & tempbillno & "'"
4745
4746 conn.Execute "UPDATE tbl_T_chargesdiscount " _
4747 & "SET userid = '" & userloginid & "'," _
4748 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4749 & "updatests = 'D' " _
4750 & "WHERE transacno = '" & tempbillno & "'"
4751
4752 conn.Execute "DELETE FROM tbl_T_transacno " _
4753 & "WHERE suspendtransacno = '" & tempbillno & "' " _
4754 & "AND stationno = '" & stationno & "'"
4755
4756 conn.Execute "UPDATE tbl_T_charges SET charges = 0, discount = 0, vat = 0," _
4757 & "payment = 0, overdue = 0 WHERE transacno = '" & tempbillno & "'"
4758
4759 tempbillno = ""
4760 lblmove.Visible = True
4761 lblaction.Visible = False
4762 lblaction.Caption = ""
4763 txtaction.Locked = True
4764 txtaction.Visible = False
4765 lvworder.ListItems.Clear
4766 frachoose.Visible = True
4767 lblf10.Visible = True
4768 frapayment.Visible = False
4769 frarecall.Visible = False
4770 Call cleartext
4771 Call vieworderlist
4772 frabarcode.Enabled = True
4773 frasearch.Enabled = False
4774 fraview.Enabled = False
4775 txtbarcode.Text = ""
4776 txtsearch.Text = ""
4777 txtbarcode.SetFocus
4778 Else
4779 txtbarcode.SetFocus
4780 End If
4781
4782 Case 2
4783 Call enabledisable(True)
4784 Call vieworderlist
4785 lblaction.Caption = "Select an item to edit."
4786 txtaction.Visible = False
4787 frabarcode.Enabled = False
4788 lvworder.SetFocus
4789
4790 Case 3
4791 Call enabledisable(True)
4792 Call vieworderlist
4793 lblaction.Caption = "Select an item to delete."
4794 lblf3.Caption = "F3 - Delete"
4795 txtaction.Visible = False
4796 frabarcode.Enabled = False
4797 lvworder.SetFocus
4798
4799 Case 6
4800 Call enabledisable(True)
4801 Call vieworderlist
4802 lblaction.Caption = "Suspension Tag"
4803 txtaction.Visible = True
4804 txtaction.Text = ""
4805 txtaction.Alignment = 0
4806 txtaction.MaxLength = 17
4807 txtaction.Locked = False
4808 lblf6.Caption = "F6 - Suspend"
4809 frabarcode.Enabled = False
4810 txtaction.SetFocus
4811
4812 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_M_syscon " _
4813 & "WHERE modulename = 'SUSPEND'")
4814 suspendctr = Val(rspos!lastnumber) + 1
4815
4816 suspendini = "S" & suspendctr
4817
4818 conn.Execute "UPDATE tbl_M_syscon " _
4819 & "SET lastnumber = '" & suspendctr & "' " _
4820 & "WHERE modulename = 'SUSPEND'"
4821
4822 Case 7
4823 Call enabledisable(True)
4824 Call modmain.rsConnection(rsloadlist, "SELECT suspensiontag FROM tbl_T_transacno " _
4825 & "WHERE suspensiontag IS NOT NULL " _
4826 & "AND stationno = '" & stationno & "'")
4827 If rsloadlist.EOF = True Then
4828 MsgBox "No suspended transaction made.", vbCritical, systemname
4829 txtbarcode.SetFocus
4830 Else
4831 frachoose.Visible = False
4832 lblf10.Visible = False
4833 frapayment.Visible = False
4834 frarecall.Visible = True
4835 Call loadsuspend
4836 lstrecall.SetFocus
4837 End If
4838
4839 Case 8
4840
4841 fradiscount.Visible = True
4842 Call loaddiscount
4843 Call cleardiscount
4844 cbodiscount.SetFocus
4845
4846 Case 11
4847 Call enabledisable(True)
4848 bolpos = True
4849 posallowed = UCase(txtposuser.Text)
4850 frmposvoid.Show vbModal
4851
4852 Case 12
4853 Call enabledisable(True)
4854 bolpos = True
4855 posallowed = UCase(txtposuser.Text)
4856 frmposreprint.Show vbModal
4857 Case 13
4858 Call enabledisable(True)
4859 bolpos = True
4860 posallowed = UCase(txtposuser.Text)
4861 frmposreturn.Show vbModal
4862
4863 End Select
4864 End If
4865 End If
4866 End If
4867End Sub
4868
4869Private Sub cmdpasscancel_Click()
4870 frapassword.Visible = False
4871 Call enabledisable(True)
4872
4873 If frabarcode.Enabled = True Then
4874 txtbarcode.SetFocus
4875 End If
4876End Sub
4877
4878Sub usevariables()
4879
4880 isPWD = 0
4881 isSeniorCitizen = 0
4882
4883 cashamt = 0
4884 cardamt = 0
4885
4886 chargeamt = 0
4887 couponamt = 0
4888 cardtext = ""
4889 chargetext = ""
4890 coupontext = ""
4891End Sub
4892
4893Sub totalpayments()
4894 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
4895 & "WHERE transacno = '" & transacno & "' " _
4896 & "AND cancelled = 0")
4897 For ctr = 1 To rspayment.RecordCount
4898 paymentmodeid = rspayment!paymentmodeid
4899 Call modmain.rsConnection(rspaymentmode, "SELECT * FROM tbl_M_paymentmode " _
4900 & "WHERE paymentmodeid = '" & paymentmodeid & "'")
4901 paymentmode = rspaymentmode!paymentmode
4902 With rspayment
4903 Select Case paymentmode
4904 Case "CASH"
4905 cashamt = cashamt + !amount
4906 Case "CREDIT CARD"
4907 cardamt = cardamt + !amount
4908 Case "CHARGE"
4909 chargeamt = chargeamt + !amount
4910 Case "COUPON"
4911 couponamt = couponamt + !amount
4912 End Select
4913
4914 .MoveNext
4915 End With
4916 rspaymentmode.Close
4917 Next ctr
4918 rspayment.Close
4919End Sub
4920
4921Sub printfunction()
4922On Error GoTo LogError
4923
4924
4925 Screen.MousePointer = vbHourglass
4926 '---updated by HSA 8/13/2012 --- open cash drawer first before printing
4927
4928 LogInfo "Opening Cash Drawer"
4929 Call EnableCashDrawer
4930 '-----
4931
4932
4933 LogInfo "Executing Total Payments"
4934 Call totalpayments
4935
4936 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_charges " _
4937 & "WHERE transacno = '" & transacno & "'")
4938 trxdate = Format(rspayment!datetimetrx, "mm/dd/yyyy")
4939 trxtime = Format(rspayment!datetimetrx, "hh:mm:ss AM/PM")
4940 charges = Format(rspayment!charges, "###0.00")
4941 discountamt = Format(rspayment!discount, "###0.00")
4942 vatamt = Format(rspayment!vat, "###0.00")
4943 vatlesspayable = Format(rspayment!vatlessprice, "###0.00")
4944 overdue = Format(rspayment!overdue, "###0.00")
4945 rspayment.Close
4946
4947 If Val(Format(vatamt, "###0.00")) > 0 Then
4948 vatexempt = 0
4949 Else
4950 vatexempt = 1
4951 End If
4952 '--- Added by RHV 08/17/201
4953
4954 If discinfoid = 1 Then
4955 payable = Val(totalvatlessprice) - Val(discountamt)
4956
4957 Else
4958 payable = Val(charges) - Val(discountamt)
4959 End If
4960
4961 vatdisplay = Val(vatrate * 100)
4962
4963If discinfoid = 1 Then
4964 Dim vatexemptsales As Double
4965 vatexemptsales = totalvatlessprice - vatlesspayable - vatamt
4966 If (vatexemptsales < 0) Then
4967 vatexemptsales = 0
4968 End If
4969
4970 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4971 & "vatexemptsales = '" & vatexemptsales & "'," _
4972 & "totalpayable = '" & payable & "'" _
4973 & "WHERE transacno = '" & transacno & "'"
4974 If vatexempt = 1 Then
4975 Dim temp As Double
4976 temp = 0
4977 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4978 & "vatablesales= '" & temp & "'" _
4979 & "WHERE transacno = '" & transacno & "'"
4980 Else
4981 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4982 & "vatablesales= '" & Format(CDbl(totalSeniorCitizenVatableSales), "###0.00") & "'" _
4983 & "WHERE transacno = '" & transacno & "'"
4984 End If
4985
4986 ElseIf discinfoid = 16 Then '---------------haide--------------
4987 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4988 & "vatablesales= '" & Format(CDbl(totalVatable), "###0.00") & "'," _
4989 & "vatexemptsales = '" & 0 & "'," _
4990 & "totalpayable = '" & totalpayable & "'" _
4991 & "WHERE transacno = '" & transacno & "'"
4992 Else
4993 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
4994 & "vatablesales= '" & Format(CDbl(vatlesspayable), "###0.00") & "'," _
4995 & "vatexemptsales = '" & 0 & "'," _
4996 & "totalpayable = '" & payable & "'" _
4997 & "WHERE transacno = '" & transacno & "'"
4998
4999 End If
5000
5001 If customerDiscountName <> "" Then
5002 conn.Execute "UPDATE tbl_T_charges SET datetimetrx = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
5003 & "customername= '" & customerDiscountName & "'," _
5004 & "customerid = '" & customerDiscountID & "'" _
5005 & "WHERE transacno = '" & transacno & "'"
5006 End If
5007
5008
5009 Dim ESC As String * 1
5010 Dim printdatetime As String
5011 Dim PrintError As Boolean
5012
5013 PrintError = False
5014
5015 'Initialization
5016 ESC = Chr(&H1B) 'ESC command
5017 printdatetime = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM") 'system date
5018
5019 LogInfo "Sending data to POS Printer"
5020
5021 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
5022 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
5023 LogInfo "Releasing POS Printer"
5024 Call releaseprinter
5025 LogInfo "Initializing POS Printer"
5026 Call initprinter
5027 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
5028 'PrintError = True
5029 PrintError = False
5030 LogInfo "POS Printer still returned Error"
5031 End If
5032 End If
5033
5034 LogInfo "Creating File for eJournal"
5035 Dim fs As FileSystemObject
5036 Dim ts As TextStream
5037 Set fs = New FileSystemObject
5038 'To write
5039 Set ts = fs.OpenTextFile(ejournalpath & "\" & Format(Now(), "yyyymmdd") & ".txt", ForAppending, True)
5040
5041 If PrintError = False Then
5042 With OPOSPOSPrinter1
5043 'Header
5044 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "DALUNAN MANAGEMENT SERVICES" + vbCrLf
5045 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "24/7 QUICKMART" + vbCrLf
5046 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "GF FUENTE TOWER II" + vbCrLf
5047 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY" + vbCrLf
5048 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "VAT REG TIN 903-740-466-005" + vbCrLf
5049 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "S/N: " + printerserialno + ESC + "|N" + vbCrLf
5050 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "MIN: " + MachineID + vbCrLf
5051 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "eAccred: " + eAccred + vbCrLf
5052 End With
5053 LogInfo "Finished Printing Header"
5054 End If
5055
5056 LogInfo "Bypass Printing Header"
5057
5058 LogInfo "Printing Header to eJournal"
5059 'Print to Text File
5060 '--------------
5061 ts.WriteLine "--------------------------------------"
5062 ts.WriteLine "DALUNAN MANAGEMENT SERVICES"
5063 ts.WriteLine "24/7 QUICKMART"
5064 ts.WriteLine "GF FUENTE TOWER II"
5065 ts.WriteLine "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY"
5066 ts.WriteLine "VAT REG TIN 903-740-466-005"
5067 ts.WriteLine "S/N: " + printerserialno
5068 ts.WriteLine "MIN: " + MachineID
5069 ts.WriteLine "eAccred: " + eAccred
5070 LogInfo "Finished Printing Header to File"
5071
5072 If PrintError = False Then
5073 With OPOSPOSPrinter1
5074 '--------------
5075 'Line
5076 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
5077
5078 'Bill No. and print datetime
5079 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + transacno + Space$(13) + "POS Stn: " + stationno + vbCrLf
5080 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + trxdate + Space$(2) + trxtime + vbCrLf + vbCrLf
5081 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "QTY" + Space$(1) + "DESCRIPTION" + Space$(13) + "TOTAL" + vbCrLf
5082 '--------
5083 End With
5084 LogInfo "Finished Printing Item Header"
5085 End If
5086
5087 LogInfo "Bypassed Printing Item Header"
5088
5089 LogInfo "Printing Item Header to eJournal"
5090
5091 ts.WriteLine Space$(33)
5092 ts.WriteLine transacno + Space$(13) + "POS Stn: " + stationno
5093 ts.WriteLine trxdate + Space$(2) + trxtime
5094 ts.WriteLine "QTY" + Space$(1) + "DESCRIPTION" + Space$(13) + "TOTAL"
5095 LogInfo "Finished Printing Item Header to File"
5096
5097 '--------
5098 'GUIDE
5099 '.PrintNormal PTR_S_RECEIPT, "000" + Space$(1) + "0000000000" + Space$(1) + "0,000.00" + Space$(1) + "00,000.00" + vbCrLf
5100
5101 'Items
5102 For i = 1 To lvworder.ListItems.Count
5103 LogInfo "Printing Item " & i
5104 unitcost = Format(lvworder.ListItems(i).SubItems(5), "###0.00")
5105 sellingprice = Format(lvworder.ListItems(i).SubItems(7), "###0.00")
5106
5107 If Val(Format(lvworder.ListItems(i).SubItems(6), "###0")) > 1 Then
5108 If PrintError = False Then
5109 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "@" + Space$(1) + Format$(unitcost, "#,##0.00") + vbCrLf
5110 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
5111 LogInfo "Error Printing Item " & i
5112 MsgBox "Printer Error - Please Reprint bill after transaction", vbCritical, systemname
5113 PrintError = True
5114 End If
5115 End If
5116 ts.WriteLine "@" + Space$(1) + Format$(unitcost, "#,##0.00")
5117 End If
5118
5119 If PrintError = False Then
5120 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, Format$(Format$(lvworder.ListItems(i).SubItems(6), "#,##0"), "@@@") _
5121 + Space$(1) _
5122 + PadR(Left$(lvworder.ListItems(i).SubItems(3), 19), 19, " ") _
5123 + Space$(1) _
5124 + Format$(Format$(sellingprice, "#,##0.00"), "@@@@@@@@@") _
5125 + vbCrLf
5126
5127 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
5128 LogInfo "Error Printing Item " & i
5129 MsgBox "Printer Error - Please Reprint bill after transaction", vbCritical, systemname
5130 PrintError = True
5131 End If
5132
5133 '------
5134 End If
5135
5136 ts.WriteLine Format$(Format$(lvworder.ListItems(i).SubItems(6), "#,##0"), "@@@") _
5137 + Space$(1) _
5138 + PadR(Left$(lvworder.ListItems(i).SubItems(3), 19), 19, " ") _
5139 + Space$(1) _
5140 + Format$(Format$(sellingprice, "#,##0.00"), "@@@@@@@@@") _
5141 '------
5142 Next i
5143
5144
5145 'Line
5146 If PrintError = False Then
5147 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
5148 End If
5149
5150 ts.WriteLine Space$(33)
5151
5152
5153 'TOTAL QTY
5154 If PrintError = False Then
5155 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL QTY", 23, " ") + Format$(Format$(txtTotalQty.Text, "#,##0"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5156 End If
5157
5158 If PrintError = False Then
5159 With OPOSPOSPrinter1
5160 'Charges
5161 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGES", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5162 If discinfoid = 1 Then
5163
5164 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXEMPT SALES ", 23, " ") + Format$(Format$(totalvatlessprice - CDbl(vatlesspayable) - CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5165
5166 If vatexempt = 1 Then
5167
5168 temp = 0
5169 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(temp, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5170 Else
5171 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(totalSeniorCitizenVatableSales), "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5172 End If
5173
5174 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("SENIOR DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5175 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE ", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5176
5177 ElseIf discinfoid = 16 Then '---------------haide--------------
5178 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("PWD DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5179 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(totalVatable), "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5180 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(totalpayable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5181 Else
5182 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5183 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5184
5185 End If
5186 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5187 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5188 ' ---------
5189 End With
5190 End If
5191
5192 ts.WriteLine "---------------------------------"
5193 ts.WriteLine PadR("TOTAL QTY", 23, " ") + Format$(Format$(txtTotalQty.Text, "#,##0"), "@@@@@@@@@@")
5194 ts.WriteLine PadR("CHARGES", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@")
5195
5196 'ts.WriteLine PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5197 If discinfoid = 1 And discountamt <> 0 Then
5198 ts.WriteLine PadR("VAT EXEMPT SALES", 23, " ") + Format$(Format$(totalvatlessprice - CDbl(vatlesspayable) - CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@")
5199 If vatexempt = 1 Then
5200 temp = 0
5201 ts.WriteLine PadR("VATABLE SALES", 23, " ") + Format$(Format$(temp, "#,##0.00"), "@@@@@@@@@@")
5202 Else
5203 ts.WriteLine PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(totalSeniorCitizenVatableSales), "#,##0.00"), "@@@@@@@@@@")
5204 End If
5205 ts.WriteLine PadR("SENIOR DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5206 ts.WriteLine PadR("TOTAL PAYABLE ", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@")
5207 ElseIf discinfoid = 16 Then
5208 ts.WriteLine PadR("PWD DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5209 ts.WriteLine PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(totalVatable), "#,##0.00"), "@@@@@@@@@@")
5210 ts.WriteLine PadR("TOTAL PAYABLE ", 23, " ") + Format$(Format$(totalpayable, "#,##0.00"), "@@@@@@@@@@")
5211 Else
5212 ts.WriteLine PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5213 ts.WriteLine PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@")
5214 End If
5215 'ts.WriteLine PadR("VAT LESS PAYABLE ", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@")
5216 ' ---------
5217
5218
5219 'Payments
5220 LogInfo "Printing Payments"
5221 If Val(cardamt) > 0 Then
5222 If PrintError = False Then
5223 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5224 End If
5225
5226 ts.WriteLine PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@")
5227 End If
5228
5229 If Val(chargeamt) > 0 Then
5230 If PrintError = False Then
5231 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5232 End If
5233
5234 ts.WriteLine PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@")
5235 End If
5236
5237 If Val(couponamt) > 0 Then
5238 If PrintError = False Then
5239 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5240 End If
5241
5242 ts.WriteLine PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@")
5243 End If
5244
5245 If Val(cashamt) > 0 Then
5246 If PrintError = False Then
5247 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5248 End If
5249
5250 ts.WriteLine PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@")
5251 End If
5252
5253 'Change
5254 If PrintError = False Then
5255 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHANGE", 23, " ") + Format$(Format$(overdue, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf + vbCrLf
5256 End If
5257
5258 ts.WriteLine PadR("CHANGE", 23, " ") + Format$(Format$(overdue, "#,##0.00"), "@@@@@@@@@@")
5259 ts.WriteLine " "
5260
5261 'VAT
5262 LogInfo "Printing VAT"
5263 If vatexempt = 1 Then
5264 If PrintError = False Then
5265 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "VAT EXEMPT" + ESC + "|N" + vbCrLf
5266 End If
5267
5268 ts.WriteLine "VAT EXEMPT"
5269 Else
5270 If PrintError = False Then
5271
5272 If isPWD Then
5273 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX" + ESC + "|N" + vbCrLf
5274 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "V" _
5275 + Space$(1) _
5276 + vatdisplay + "%" _
5277 + Space$(7) _
5278 + Format$(Format$(totalVatable, "#,##0.00"), "@@@@@@@@@@") _
5279 + Space$(2) _
5280 + Format$(Format$(totaltax, "#,##0.00"), "@@@@@@@@@") _
5281 + ESC + "|N" + vbCrLf
5282 Else
5283 'VAT Breakdown
5284 '000000000000000000000000000000000
5285 'VAT RATE AMOUNT TAX
5286 'V 12% 000.000.00 00.000.00
5287 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX" + ESC + "|N" + vbCrLf
5288 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "V" _
5289 + Space$(1) _
5290 + vatdisplay + "%" _
5291 + Space$(7) _
5292 + Format$(Format$(vatlesspayable, "#,##0.00"), "@@@@@@@@@@") _
5293 + Space$(2) _
5294 + Format$(Format$(vatamt, "#,##0.00"), "@@@@@@@@@") _
5295 + ESC + "|N" + vbCrLf
5296 End If
5297
5298 End If
5299
5300 If isPWD Then
5301 ts.WriteLine "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX"
5302 ts.WriteLine _
5303 Space$(1) _
5304 + vatdisplay + "%" _
5305 + Space$(7) _
5306 + Format$(Format$(totalVatable, "#,##0.00"), "@@@@@@@@@@") _
5307 + Space$(2) _
5308 + Format$(Format$(totaltax, "#,##0.00"), "@@@@@@@@@")
5309 Else
5310 ts.WriteLine "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX"
5311 ts.WriteLine _
5312 Space$(1) _
5313 + vatdisplay + "%" _
5314 + Space$(7) _
5315 + Format$(Format$(vatlesspayable, "#,##0.00"), "@@@@@@@@@@") _
5316 + Space$(2) _
5317 + Format$(Format$(vatamt, "#,##0.00"), "@@@@@@@@@")
5318 End If
5319
5320
5321 End If
5322
5323 'Payment details
5324 LogInfo "Printing Payment Details"
5325 If Val(cardamt) > 0 Then
5326
5327 If PrintError = False Then
5328 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Card Info:" + ESC + "|N" + vbCrLf
5329 End If
5330 ts.WriteLine "Card Info:"
5331
5332 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5333 & "WHERE transacno = '" & transacno & "' " _
5334 & "AND cancelled = 0 AND paymentmodeid = 2")
5335
5336 For ctr = 1 To rspayment.RecordCount
5337
5338 If PrintError = False Then
5339 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5340 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "Card #:" + rspayment!cardno + ESC + "|N" + vbCrLf
5341 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + "Amount:" + Format$(rspayment!exactamount, "#,##0.00") + ESC + "|N" + vbCrLf
5342 End If
5343
5344 ts.WriteLine rspayment!reminder
5345 ts.WriteLine "Card #:" + rspayment!cardno
5346 ts.WriteLine "Amount:" + Format$(rspayment!exactamount, "#,##0.00")
5347
5348 rspayment.MoveNext
5349 Next ctr
5350
5351 rspayment.Close
5352
5353 End If
5354
5355
5356 If Val(chargeamt) > 0 Then
5357
5358 If PrintError = False Then
5359 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Charge to:" + ESC + "|N" + vbCrLf
5360 End If
5361
5362 ts.WriteLine "Charge to:"
5363
5364 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5365 & "WHERE transacno = '" & transacno & "' " _
5366 & "AND cancelled = 0 AND paymentmodeid = 3")
5367
5368 For ctr = 1 To rspayment.RecordCount
5369 If PrintError = False Then
5370 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5371 End If
5372
5373 ts.WriteLine rspayment!reminder
5374
5375 rspayment.MoveNext
5376 Next ctr
5377 rspayment.Close
5378
5379 End If
5380
5381
5382 If Val(couponamt) > 0 Then
5383 If PrintError = False Then
5384 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Coupon No.:" + ESC + "|N" + vbCrLf
5385 End If
5386
5387 ts.WriteLine "Coupon No.:"
5388
5389 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5390 & "WHERE transacno = '" & transacno & "' " _
5391 & "AND cancelled = 0 AND paymentmodeid = 4")
5392
5393 For ctr = 1 To rspayment.RecordCount
5394 If PrintError = False Then
5395 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5396 End If
5397
5398 ts.WriteLine rspayment!reminder
5399 rspayment.MoveNext
5400 Next ctr
5401 rspayment.Close
5402
5403 End If
5404
5405
5406 'Loyaly Points
5407 If Me.txtPCardNo.Text <> "" Then
5408
5409 If CardnumberExist = True Then
5410
5411 Call modmain.rsConnection(rspayment, "SELECT ClientName = LastName + ',' + FirstName FROM tbl_M_pcardmain " _
5412 & "WHERE pcardnumber = '" & pcardnumber & "'")
5413
5414 If PrintError = False Then
5415 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Transaction Pts: " + Format(dbltnxpoints, "#,##0.00")
5416 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Total Earned Pts: " + Format(dblTotalPoints, "#,##0.00")
5417 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "ClientName: " + rspayment!ClientName
5418 End If
5419
5420 ts.WriteLine "Transaction Pts: " + Format(dbltnxpoints, "#,##0.00")
5421 ts.WriteLine "Total Earned Pts: " + Format(dblTotalPoints, "#,##0.00")
5422 ts.WriteLine "ClientName: " + rspayment!ClientName
5423
5424 rspayment.Close
5425
5426 End If
5427
5428 End If
5429
5430 'Cashier
5431 If PrintError = False Then
5432 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text)
5433 End If
5434
5435 ts.WriteLine "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text)
5436
5437
5438 'Bagger
5439 If PrintError = False Then
5440 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Bagger: " + UCase(cbobagger.Text) + vbCrLf
5441 If customerDiscountName <> "" Then
5442 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Customer Name: " + customerDiscountName
5443 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Customer ID: " + customerDiscountID + vbCrLf + vbCrLf
5444 End If
5445 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "THIS IS YOUR OFFICIAL RECEIPT" + vbCrLf
5446 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|cA" + printdatetime + vbCrLf
5447 End If
5448
5449 ts.WriteLine "Bagger: " + UCase(cbobagger.Text) + vbCrLf
5450
5451 '-------------------edited by haide----------------------
5452 ts.WriteLine "Customer Name: " + customerDiscountName
5453 ts.WriteLine "Customer ID: " + customerDiscountID + vbCrLf
5454
5455 ts.WriteLine "THIS IS YOUR OFFICIAL RECEIPT"
5456 ts.WriteLine printdatetime
5457
5458
5459 'Feed the receipt to the cutter position automatically, and cut.
5460 ' ESC|#fP = Line Feed and Paper cut
5461 If PrintError = False Then
5462 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|fP"
5463 End If
5464
5465 ts.WriteLine "--------------------------------------"
5466
5467 ts.Close
5468
5469 'clear memory used by FSO objects
5470 Set ts = Nothing
5471 Set fs = Nothing
5472
5473 LogInfo "Finished Printing"
5474' Open "LPT1" For Output As #1
5475' Print #1, Chr$(27); Chr$(112); Chr$(0)
5476' Close #1
5477
5478
5479 strsql = "INSERT INTO tbl_T_audittrail(trandate,posstation," _
5480 & "shiftno,userloginid,activity,transacno, amount, userlevel) " _
5481 & "VALUES('" & Format(Now(), "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
5482 & "','" & stationno & "','" & shiftno _
5483 & "','" & username _
5484 & "','PAYMENT', '" & transacno & "' , " & payable & ", " & accesslevelid & ")"
5485
5486 conn.Execute strsql
5487
5488
5489 txtPCardNo.Text = ""
5490 txtTotalQty.Text = "0"
5491 Screen.MousePointer = vbDefault
5492
5493
5494
5495 ' OPOSCashDrawer1.OpenDrawer
5496
5497 ' When the drawer is not closed in ten seconds after opening, beep until closed.
5498' If executed the method, no values are returned until the drawer is closed.
5499 OPOSCashDrawer1.WaitForDrawerClose 10000, 2000, 100, 1000
5500
5501
5502
5503' Select Case OPOSCashDrawer1.ResultCodeExtended
5504' Case OPOS_EPTR_COVER_OPEN
5505' LogInfo "Printer Cover Open Error"
5506' MsgBox "Open Drawer Error" & vbCrLf & "Printer Cover Open", vbCritical, systemname
5507' Case OPOS_EPTR_JRN_EMPTY
5508' LogInfo "Printer Journal Empty Error"
5509' MsgBox "Open Drawer Error" & vbCrLf & "Printer Journal Empty", vbCritical, systemname
5510' Case OPOS_EPTR_REC_EMPTY
5511' LogInfo "Printer Receipt Empty Error"
5512' MsgBox "Open Drawer Error" & vbCrLf & "Printer Receipt Empty", vbCritical, systemname
5513' Case Else
5514' LogInfo "Result Code: " & OPOSCashDrawer1.ResultCode
5515' LogInfo "Extended Result Code: " & OPOSCashDrawer1.ResultCodeExtended
5516' If (OPOSCashDrawer1.ResultCode <> OPOS_SUCCESS) Then
5517' LogInfo "Open Drawer Error"
5518' MsgBox "Open Drawer Error. Please open door Manually", vbCritical, systemname
5519' LogInfo "Cash Drawer opened manually"
5520' Text1.Text = "Open"
5521' Text3.Text = "Open"
5522' firstload = False
5523' End If
5524' End Select
5525
5526 Exit Sub
5527
5528LogError:
5529 LogInfo "Error - " & Err.description
5530 Resume Next
5531End Sub
5532Sub printfunctionBIR()
5533
5534 Screen.MousePointer = vbHourglass
5535
5536 'Call totalpayments
5537
5538 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_charges " _
5539 & "WHERE transacno = '" & transacno & "'")
5540 trxdate = Format(rspayment!datetimetrx, "mm/dd/yyyy")
5541 trxtime = Format(rspayment!datetimetrx, "hh:mm:ss AM/PM")
5542 charges = Format(rspayment!charges, "###0.00")
5543 discountamt = Format(rspayment!discount, "###0.00")
5544 vatamt = Format(rspayment!vat, "###0.00")
5545 vatlesspayable = Format(rspayment!vatlessprice, "###0.00")
5546 overdue = Format(rspayment!overdue, "###0.00")
5547 rspayment.Close
5548
5549 If Val(Format(vatamt, "###0.00")) > 0 Then
5550 vatexempt = 0
5551 Else
5552 vatexempt = 1
5553 End If
5554 '--- Added by RHV 08/17/2011
5555 If discinfoid = 1 And Val(discountamt) <> 0 Then
5556 payable = Val(totalvatlessprice) - Val(discountamt)
5557 Else
5558 payable = Val(charges) - Val(discountamt)
5559 End If
5560 '---
5561 vatdisplay = Val(vatrate * 100)
5562
5563 Dim ESC As String * 1
5564 Dim printdatetime As String
5565
5566 'Initialization
5567 ESC = Chr(&H1B) 'ESC command
5568 printdatetime = Format(Now, "mm/dd/yyyy hh:mm:ss AM/PM") 'system date
5569
5570
5571 Dim fs As FileSystemObject
5572 Dim ts As TextStream
5573 Set fs = New FileSystemObject
5574 'To write
5575 Set ts = fs.OpenTextFile(ejournalpath & "\Back\" & Format(Now(), "yyyymmdd") & ".txt", ForAppending, True)
5576
5577 With OPOSPOSPrinter1
5578 'Header
5579' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "DALUNAN MANAGEMENT SERVICES" + vbCrLf
5580' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "24/7 QUICKMART" + vbCrLf
5581' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "GF FUENTE TOWER II" + vbCrLf
5582' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY" + vbCrLf
5583' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "VAT REG TIN 903-740-466-005" + vbCrLf
5584' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "S/N: " + printerserialno + ESC + "|N" + vbCrLf
5585' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "MIN: " + MachineID + vbCrLf
5586' .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "eAccred: " + eAccred + vbCrLf
5587 'Print to Text File
5588 '--------------
5589 ts.WriteLine "--------------------------------------"
5590 ts.WriteLine "DALUNAN MANAGEMENT SERVICES"
5591 ts.WriteLine "24/7 QUICKMART"
5592 ts.WriteLine "GF FUENTE TOWER II"
5593 ts.WriteLine "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY"
5594 ts.WriteLine "VAT REG TIN 903-740-466-005"
5595 ts.WriteLine "S/N: " + printerserialno
5596 ts.WriteLine "MIN: " + MachineID
5597 ts.WriteLine "eAccred: " + eAccred
5598 '--------------
5599' 'Line
5600' .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
5601'
5602' 'Bill No. and print datetime
5603' .PrintNormal PTR_S_RECEIPT, ESC + "|N" + transacno + Space$(13) + "POS Stn: " + stationno + vbCrLf
5604' .PrintNormal PTR_S_RECEIPT, ESC + "|N" + trxdate + Space$(2) + trxtime + vbCrLf + vbCrLf
5605' .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "QTY" + Space$(1) + "DESCRIPTION" + Space$(13) + "TOTAL" + vbCrLf
5606 '--------
5607 ts.WriteLine Space$(33)
5608 ts.WriteLine transacnoBIR + Space$(13) + "POS Stn: " + stationno
5609 ts.WriteLine trxdate + Space$(2) + trxtime
5610 ts.WriteLine "QTY" + Space$(1) + "DESCRIPTION" + Space$(13) + "TOTAL"
5611 '--------
5612 'GUIDE
5613 '.PrintNormal PTR_S_RECEIPT, "000" + Space$(1) + "0000000000" + Space$(1) + "0,000.00" + Space$(1) + "00,000.00" + vbCrLf
5614
5615 'Items
5616 For i = 1 To lvworder.ListItems.Count
5617
5618 unitcost = Format(lvworder.ListItems(i).SubItems(5), "###0.00")
5619 sellingprice = Format(lvworder.ListItems(i).SubItems(7), "###0.00")
5620
5621 If Val(Format(lvworder.ListItems(i).SubItems(6), "###0")) > 1 Then
5622 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "@" + Space$(1) + Format$(unitcost, "#,##0.00") + vbCrLf
5623 ts.WriteLine "@" + Space$(1) + Format$(unitcost, "#,##0.00")
5624 End If
5625
5626' .PrintNormal PTR_S_RECEIPT, Format$(Format$(lvworder.ListItems(i).SubItems(6), "#,##0"), "@@@") _
5627' + Space$(1) _
5628' + PadR(Left$(lvworder.ListItems(i).SubItems(3), 19), 19, " ") _
5629' + Space$(1) _
5630' + Format$(Format$(sellingprice, "#,##0.00"), "@@@@@@@@@") _
5631' + vbCrLf
5632 '------
5633 ts.WriteLine Format$(Format$(lvworder.ListItems(i).SubItems(6), "#,##0"), "@@@") _
5634 + Space$(1) _
5635 + PadR(Left$(lvworder.ListItems(i).SubItems(3), 19), 19, " ") _
5636 + Space$(1) _
5637 + Format$(Format$(sellingprice, "#,##0.00"), "@@@@@@@@@") _
5638 '------
5639
5640 Next i
5641
5642 'Line
5643 '.PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
5644 ts.WriteLine Space$(33)
5645 'TOTAL QTY
5646 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL QTY", 23, " ") + Format$(Format$(txtTotalQty.Text, "#,##0"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5647
5648 'Charges
5649 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGES", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5650 'If discinfoid = 1 And discountamt <> 0 Then
5651 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXEMPT SALES", 23, " ") + Format$(Format$(totalvatlessprice - CDbl(vatlesspayable) - CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5652 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(vatlesspayable) + CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5653 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("SENIOR DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5654 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE ", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5655 'Else
5656 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5657 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5658 'End If
5659 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5660 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5661
5662 ' ---------
5663 ts.WriteLine "---------------------------------"
5664 ts.WriteLine PadR("TOTAL QTY", 23, " ") + Format$(Format$(txtTotalQty.Text, "#,##0"), "@@@@@@@@@@")
5665 ts.WriteLine PadR("CHARGES", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@")
5666
5667 'ts.WriteLine PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5668 If discinfoid = 1 And discountamt <> 0 Then
5669 ts.WriteLine PadR("VAT EXEMPT SALES", 23, " ") + Format$(Format$(totalvatlessprice - CDbl(vatlesspayable) - CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@")
5670 ts.WriteLine PadR("VATABLE SALES", 23, " ") + Format$(Format$(CDbl(vatlesspayable) + CDbl(vatamt), "#,##0.00"), "@@@@@@@@@@")
5671 ts.WriteLine PadR("SENIOR DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5672 ts.WriteLine PadR("TOTAL PAYABLE ", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@")
5673 Else
5674 ts.WriteLine PadR("DISCOUNT", 23, " ") + Format$(Format$(discountamt, "#,##0.00"), "@@@@@@@@@@")
5675 ts.WriteLine PadR("TOTAL PAYABLE", 23, " ") + Format$(Format$(payable, "#,##0.00"), "@@@@@@@@@@")
5676 End If
5677 'ts.WriteLine PadR("VAT LESS PAYABLE ", 23, " ") + Format$(Format$(charges, "#,##0.00"), "@@@@@@@@@@")
5678 ' ---------
5679 'Payments
5680 If Val(cardamt) > 0 Then
5681 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5682 ts.WriteLine PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@")
5683 End If
5684 If Val(chargeamt) > 0 Then
5685 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5686 ts.WriteLine PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@")
5687 End If
5688 If Val(couponamt) > 0 Then
5689 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5690 ts.WriteLine PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@")
5691 End If
5692 If Val(cashamt) > 0 Then
5693 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
5694 ts.WriteLine PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@")
5695 End If
5696
5697 'Change
5698 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHANGE", 23, " ") + Format$(Format$(overdue, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf + vbCrLf
5699 ts.WriteLine PadR("CHANGE", 23, " ") + Format$(Format$(overdue, "#,##0.00"), "@@@@@@@@@@")
5700 ts.WriteLine " "
5701 'VAT
5702 If vatexempt = 1 Then
5703 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + "VAT EXEMPT" + ESC + "|N" + vbCrLf
5704 ts.WriteLine "VAT EXEMPT"
5705 Else
5706 'VAT Breakdown
5707 '000000000000000000000000000000000
5708 'VAT RATE AMOUNT TAX
5709 'V 12% 000.000.00 00.000.00
5710' .PrintNormal PTR_S_RECEIPT, ESC + "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX" + ESC + "|N" + vbCrLf
5711' .PrintNormal PTR_S_RECEIPT, ESC + "N" + "V" _
5712' + Space$(1) _
5713' + vatdisplay + "%" _
5714' + Space$(7) _
5715' + Format$(Format$(vatlesspayable, "#,##0.00"), "@@@@@@@@@@") _
5716' + Space$(2) _
5717' + Format$(Format$(vatamt, "#,##0.00"), "@@@@@@@@@") _
5718' + ESC + "|N" + vbCrLf
5719
5720 ts.WriteLine "N" + "VAT RATE" + Space$(5) + "AMOUNT" + Space$(8) + "TAX"
5721 ts.WriteLine _
5722 Space$(1) _
5723 + vatdisplay + "%" _
5724 + Space$(7) _
5725 + Format$(Format$(vatlesspayable, "#,##0.00"), "@@@@@@@@@@") _
5726 + Space$(2) _
5727 + Format$(Format$(vatamt, "#,##0.00"), "@@@@@@@@@")
5728
5729
5730 End If
5731
5732 'Payment details
5733 If Val(cardamt) > 0 Then
5734
5735 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Card Info:" + ESC + "|N" + vbCrLf
5736 ts.WriteLine "Card Info:"
5737
5738 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5739 & "WHERE transacno = '" & transacno & "' " _
5740 & "AND cancelled = 0 AND paymentmodeid = 2")
5741 For ctr = 1 To rspayment.RecordCount
5742
5743 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5744 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + "Card #:" + rspayment!cardno + ESC + "|N" + vbCrLf
5745 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + "Amount:" + Format$(rspayment!exactamount, "#,##0.00") + ESC + "|N" + vbCrLf
5746
5747 ts.WriteLine rspayment!reminder
5748 ts.WriteLine "Card #:" + rspayment!cardno
5749 ts.WriteLine "Amount:" + Format$(rspayment!exactamount, "#,##0.00")
5750
5751 rspayment.MoveNext
5752 Next ctr
5753 rspayment.Close
5754
5755 End If
5756
5757 If Val(chargeamt) > 0 Then
5758
5759 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Charge to:" + ESC + "|N" + vbCrLf
5760 ts.WriteLine "Charge to:"
5761
5762 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5763 & "WHERE transacno = '" & transacno & "' " _
5764 & "AND cancelled = 0 AND paymentmodeid = 3")
5765 For ctr = 1 To rspayment.RecordCount
5766
5767 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5768 ts.WriteLine rspayment!reminder
5769
5770 rspayment.MoveNext
5771 Next ctr
5772 rspayment.Close
5773
5774 End If
5775
5776 If Val(couponamt) > 0 Then
5777
5778 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + vbCrLf + "Coupon No.:" + ESC + "|N" + vbCrLf
5779 ts.WriteLine "Coupon No.:"
5780
5781 Call modmain.rsConnection(rspayment, "SELECT * FROM tbl_T_payment " _
5782 & "WHERE transacno = '" & transacno & "' " _
5783 & "AND cancelled = 0 AND paymentmodeid = 4")
5784 For ctr = 1 To rspayment.RecordCount
5785
5786 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + rspayment!reminder + ESC + "|N" + vbCrLf
5787 ts.WriteLine rspayment!reminder
5788 rspayment.MoveNext
5789 Next ctr
5790 rspayment.Close
5791
5792 End If
5793
5794 If Me.txtPCardNo.Text <> "" Then
5795 'Loyaly Points
5796
5797 Call modmain.rsConnection(rspayment, "SELECT ClientName = LastName + ',' + FirstName FROM tbl_M_pcardmain " _
5798 & "WHERE pcardnumber = '" & pcardnumber & "'")
5799
5800 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Transaction Pts: " + Format(dbltnxpoints, "#,##0.00")
5801 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Total Earned Pts: " + Format(dblTotalPoints, "#,##0.00")
5802 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "ClientName: " + rspayment!ClientName
5803
5804 ts.WriteLine "Transaction Pts: " + Format(dbltnxpoints, "#,##0.00")
5805 ts.WriteLine "Total Earned Pts: " + Format(dblTotalPoints, "#,##0.00")
5806 ts.WriteLine "ClientName: " + rspayment!ClientName
5807
5808 rspayment.Close
5809 End If
5810
5811 'Cashier
5812 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text)
5813 ts.WriteLine "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text)
5814 'Bagger
5815 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Bagger: " + UCase(cbobagger.Text) + vbCrLf + vbCrLf
5816 ts.WriteLine "Bagger: " + UCase(cbobagger.Text) + vbCrLf
5817 '.PrintNormal PTR_S_RECEIPT, ESC + "|N" + vbCrLf + "Customer Name: ______________ " + vbCrLf
5818 ts.WriteLine "Customer Name: ________________" + vbCrLf
5819
5820 '.PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "THIS IS YOUR OFFICIAL RECEIPT" + vbCrLf
5821 ts.WriteLine "THIS IS YOUR OFFICIAL RECEIPT"
5822 '.PrintNormal PTR_S_RECEIPT, ESC + "|cA" + printdatetime + vbCrLf
5823 ts.WriteLine printdatetime
5824 'Feed the receipt to the cutter position automatically, and cut.
5825 ' ESC|#fP = Line Feed and Paper cut
5826 '.PrintNormal PTR_S_RECEIPT, ESC + "|fP"
5827 ts.WriteLine "--------------------------------------"
5828
5829 ts.Close
5830 'clear memory used by FSO objects
5831 Set ts = Nothing
5832 Set fs = Nothing
5833
5834 End With
5835
5836' Open "LPT1" For Output As #1
5837' Print #1, Chr$(27); Chr$(112); Chr$(0)
5838' Close #1
5839
5840
5841' strsql = "INSERT INTO tbl_T_audittrail(trandate,posstation," _
5842' & "shiftno,userloginid,activity,transacno, amount, userlevel) " _
5843' & "VALUES('" & Format(Now(), "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
5844' & "','" & stationno & "','" & shiftno _
5845' & "','" & username _
5846' & "','PAYMENT', '" & transacno & "' , " & payable & ", " & accesslevelid & ")"
5847'
5848' conn.Execute strsql
5849'
5850'
5851' txtPCardNo.Text = ""
5852' txtTotalQty.Text = "0"
5853 Screen.MousePointer = vbDefault
5854'
5855' OPOSCashDrawer1.OpenDrawer
5856' Select Case OPOSCashDrawer1.ResultCodeExtended
5857' Case OPOS_EPTR_COVER_OPEN
5858' MsgBox "Open Drawer Error" & vbCrLf & "Printer Cover Open", vbCritical, systemname
5859' Case OPOS_EPTR_JRN_EMPTY
5860' MsgBox "Open Drawer Error" & vbCrLf & "Printer Journal Empty", vbCritical, systemname
5861' Case OPOS_EPTR_REC_EMPTY
5862' MsgBox "Open Drawer Error" & vbCrLf & "Printer Receipt Empty", vbCritical, systemname
5863' Case Else
5864' If (OPOSCashDrawer1.ResultCode <> OPOS_SUCCESS) Then
5865' MsgBox "Open Drawer Error", vbCritical, systemname
5866' End If
5867' End Select
5868
5869End Sub
5870
5871Sub closefunction()
5872
5873customerDiscountName = ""
5874customerDiscountID = ""
5875totalSeniorCitizenVatableSales = 0
5876vatexemptsales = 0
5877vatablesales = 0
5878totalpayable = 0
5879
5880 LogInfo "Executing Close Function"
5881 Call enabledisable(True)
5882 lblmove.Visible = True
5883 isPWD = 0
5884 isSeniorCitizen = 0
5885
5886 lblaction.Visible = False
5887 lblaction.Caption = ""
5888 txtaction.Visible = False
5889 frachoose.Visible = True
5890 lblf10.Visible = True
5891 frapayment.Visible = False
5892 frarecall.Visible = False
5893 txtcharge.Text = "0.00"
5894 txtdiscount.Text = "0.00"
5895 txtvat.Text = "0.00"
5896 txtvatlessprice.Text = "0.00"
5897 txtpayable.Text = "0.00"
5898 txtpayment.Text = "0.00"
5899 txtoverdue.Text = "0.00"
5900 txtbarcode.Text = ""
5901 txtsearch.Text = ""
5902 frastock.Caption = "List of Orders"
5903 lvwstock.Visible = False
5904 lvworder.ListItems.Clear
5905 lvworder.Visible = True
5906 frabarcode.Enabled = True
5907 frasearch.Enabled = False
5908 fraview.Enabled = False
5909 fradrawer.Visible = False
5910
5911 MSComm1.CommPort = Val(mscommport)
5912 MSComm1.PortOpen = True
5913 MSComm1.Output = Chr$(12)
5914 MSComm1.Output = "DUE AMT" & Format$(Format$("0.00", "#,##0.00"), "@@@@@@@@@@@@@")
5915 MSComm1.PortOpen = False
5916
5917End Sub
5918
5919Public Function PadR(ByVal strOrigString As String, intLen As Integer, strPadChar As String)
5920Dim intCtr As Integer
5921Dim intOrigLen As Integer
5922
5923 intOrigLen = Len(strOrigString)
5924
5925 If intOrigLen > intLen Then
5926 PadR = Mid(strOrigString, 1, intLen)
5927 Else
5928 PadR = strOrigString & String(intLen - intOrigLen, strPadChar)
5929 End If
5930End Function
5931
5932Private Sub cmdpriceinquiry_Click()
5933On Error GoTo LogError
5934
5935 LogInfo "Price Inquiry Button Clicked"
5936 If frapayment.Visible = True Then
5937 MsgBox "You are currently transacting a payment." _
5938 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5939 cbopaymentmode.SetFocus
5940 Exit Sub
5941
5942 ElseIf frarecall.Visible = True Then
5943 MsgBox "You are currently recalling a transaction." _
5944 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5945 lstrecall.SetFocus
5946 Exit Sub
5947
5948 ElseIf lblaction.Visible = True Then
5949 If lblaction.Caption = "Choose an item." Then
5950 MsgBox "You are currently choosing an item." _
5951 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5952 txtbarcode.SetFocus
5953 Exit Sub
5954
5955 ElseIf lblaction.Caption = "Select an item to edit." Then
5956 MsgBox "You are currently selecting an item to edit." _
5957 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5958 lvworder.SetFocus
5959 Exit Sub
5960
5961 ElseIf lblaction.Caption = "Quantity" Then
5962 MsgBox "You are currently editing an item." _
5963 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5964 txtaction.SetFocus
5965 Exit Sub
5966
5967 ElseIf lblaction.Caption = "Select an item to delete." Then
5968 MsgBox "You are currently selecting an item to delete." _
5969 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5970 lvworder.SetFocus
5971 Exit Sub
5972
5973 ElseIf lblaction.Caption = "Suspension Tag" Then
5974 MsgBox "You are currently suspending an order." _
5975 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5976 lvworder.SetFocus
5977 Exit Sub
5978
5979 ElseIf lblaction.Caption = "Total Charges" Then
5980 MsgBox "You are currently doing a transaction." _
5981 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
5982 Exit Sub
5983
5984 End If
5985 End If
5986 bolpos = True
5987 frmposinquiry.Show vbModal
5988
5989 Exit Sub
5990
5991LogError:
5992 LogInfo "Error - " & Err.description
5993 Resume Next
5994End Sub
5995
5996Private Sub cmdshiftend_Click()
5997
5998 LogInfo "Shift Out Button Clicked"
5999 If frapayment.Visible = True Then
6000 MsgBox "You are currently transacting a payment." _
6001 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6002 cbopaymentmode.SetFocus
6003 Exit Sub
6004
6005 ElseIf frarecall.Visible = True Then
6006 MsgBox "You are currently recalling a transaction." _
6007 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6008 lstrecall.SetFocus
6009 Exit Sub
6010
6011 ElseIf lblaction.Visible = True Then
6012 If lblaction.Caption = "Choose an item." Then
6013 MsgBox "You are currently choosing an item." _
6014 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6015 txtbarcode.SetFocus
6016 Exit Sub
6017
6018 ElseIf lblaction.Caption = "Select an item to edit." Then
6019 MsgBox "You are currently selecting an item to edit." _
6020 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6021 lvworder.SetFocus
6022 Exit Sub
6023
6024 ElseIf lblaction.Caption = "Quantity" Then
6025 MsgBox "You are currently editing an item." _
6026 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6027 txtaction.SetFocus
6028 Exit Sub
6029
6030 ElseIf lblaction.Caption = "Select an item to delete." Then
6031 MsgBox "You are currently selecting an item to delete." _
6032 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6033 lvworder.SetFocus
6034 Exit Sub
6035
6036 ElseIf lblaction.Caption = "Suspension Tag" Then
6037 MsgBox "You are currently suspending an order." _
6038 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6039 lvworder.SetFocus
6040 Exit Sub
6041
6042 ElseIf lblaction.Caption = "Total Charges" Then
6043 MsgBox "You are currently doing a transaction." _
6044 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6045 Exit Sub
6046
6047 End If
6048 End If
6049 If MsgBox("Are you sure you want to close your shift?", vbQuestion + vbYesNo, systemname) = vbYes Then
6050 If MsgBox("Are you really sure want to close your shift?", vbQuestion + vbYesNo, systemname) = vbYes Then
6051
6052 conn.Execute "UPDATE tbl_T_shift " _
6053 & "SET shiftend = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
6054 & "userid = '" & userloginid & "'," _
6055 & "lupdatetime = '" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") & "'," _
6056 & "updatests = 'U' WHERE posstation = '" & stationno & "' " _
6057 & "AND shiftno = '" & shiftno & "' AND statusid = 1"
6058
6059 '---Validate if For BIR or Not
6060 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_M_ReportBIR ")
6061 If rspos.EOF = True Then
6062 MsgBox "Set BIR Report Table Flag", vbCritical, systemname
6063 Else
6064 If rspos!flag = 1 Then
6065 Call printxreading
6066 Else
6067 Call printxreading
6068 'strReportFlag = rspos!flag
6069 'dblPercentage = rspos!percentage
6070 Call printxreadingBIR
6071 End If
6072 End If
6073
6074 '--End for BIR
6075 conn.Execute "UPDATE tbl_T_shift " _
6076 & "SET statusid = 0 WHERE posstation = '" & stationno & "' " _
6077 & "AND shiftno = '" & shiftno & "' AND statusid = 1"
6078
6079 Select Case Val(shiftno)
6080 Case 1:
6081 shiftno = 2
6082 Case 2:
6083 shiftno = 3
6084 Case 3:
6085 shiftno = 1
6086 End Select
6087
6088 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_shift " _
6089 & "WHERE posstation = '" & stationno & "' " _
6090 & "AND shiftno = '" & shiftno & "' " _
6091 & "AND posdate = '" & Format(Now(), "mm/dd/yyyy") & "'")
6092 If rspos.EOF = True Then
6093 conn.Execute "INSERT INTO tbl_T_shift(posdate,posstation," _
6094 & "shiftno,shiftstart,statusid,userid,lupdatetime,updatests) " _
6095 & "VALUES('" & Format(Now(), "mm/dd/yyyy") _
6096 & "','" & stationno & "','" & shiftno _
6097 & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
6098 & "','1','" & userloginid _
6099 & "','" & Format(Date, "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
6100 & "','A')"
6101 End If
6102 rspos.Close
6103
6104 '--- Insert to Audit Trail
6105 strsql = "INSERT INTO tbl_T_audittrail(trandate,posstation," _
6106 & "shiftno,userloginid,activity,transacno, amount, userlevel) " _
6107 & "VALUES('" & Format(Now(), "mm/dd/yyyy") & " " & Format(Time, "hh:mm:ss AM/PM") _
6108 & "','" & stationno & "','" & shiftno _
6109 & "','" & username _
6110 & "','SHIFT OUT', 'NA', 0," & accesslevelid & ")"
6111
6112 conn.Execute strsql
6113 '---
6114
6115 bollogoff = True
6116 Unload Me
6117 Unload mainform
6118 frmlogin.Show
6119
6120
6121
6122 End If
6123 End If
6124End Sub
6125
6126Sub printxreading()
6127
6128 Screen.MousePointer = vbHourglass
6129
6130 Dim ESC As String * 1
6131 Dim printdatetime As String
6132
6133 'Initialization
6134 ESC = Chr(&H1B) 'ESC command
6135 printdatetime = Format(Now, "mm/dd/yyyy hh:mm:ssAM/PM") 'system date
6136
6137 Call modmain.rsConnection(rspos, "SELECT shiftstart,shiftend FROM tbl_T_shift " _
6138 & "WHERE posstation = '" & stationno & "' " _
6139 & "AND shiftno = '" & shiftno & "' AND statusid = 1")
6140 If Not rspos.EOF = True Then
6141 shiftstart = rspos!shiftstart
6142 shiftend = rspos!shiftend
6143 End If
6144 rspos.Close
6145
6146 'Testing Printer if ready by acj
6147 OPOSPOSPrinter1.PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
6148 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
6149 LogInfo "Releasing POS Printer"
6150 Call releaseprinter
6151 LogInfo "Initializing POS Printer"
6152 Call initprinter
6153 If OPOSPOSPrinter1.ResultCode <> OPOS_SUCCESS Then
6154 'PrintError = True
6155 'PrintError = False
6156 LogInfo "POS Printer still returned Error"
6157 End If
6158 End If
6159
6160
6161 '---For testing only
6162 '---
6163 For printerctr = 1 To Val(noofcopies)
6164
6165 With OPOSPOSPrinter1
6166 'Header
6167 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "DALUNAN MANAGEMENT SERVICES" + vbCrLf
6168 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "24/7 QUICKMART" + vbCrLf
6169 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "GF FUENTE TOWER II" + vbCrLf
6170 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY" + vbCrLf
6171 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "VAT REG TIN 903-740-466-005" + vbCrLf
6172 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "S/N: " + printerserialno + ESC + "|N" + vbCrLf
6173 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "MIN: " + vbCrLf
6174 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "eAccred: " + vbCrLf
6175
6176 'Line
6177 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
6178
6179 'Print X
6180 .PrintNormal PTR_S_RECEIPT, ESC + "|bC" + ESC + "|2C" + "X Reading" + ESC + "|N" + vbCrLf + vbCrLf
6181
6182 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "*********************************" + ESC + "|N" + vbCrLf
6183 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "SHIFT END REPORT" + ESC + "|N" + vbCrLf
6184 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "*********************************" + ESC + "|N" + vbCrLf
6185
6186 'Date and POS Station
6187 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + printdatetime + Space$(2) + "POS Stn: " + stationno + ESC + "|N" + vbCrLf
6188
6189 'Cashier
6190 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text) + ESC + "|N" + vbCrLf + vbCrLf
6191
6192 Call usevariables
6193 '-- Remove below
6194 'shiftstart = "2011-10-01 18:38:34.000"
6195 'shiftend = "2011-10-01 19:00:34.000"
6196 'shiftno = 1
6197 'stationno = 1
6198 '-------------
6199
6200' '---Added 11/05/11 for BIR
6201' strsql = "Select TOP " + CStr(dblPercentage) + " PERCENT * " _
6202' & "FROM tbl_T_charges " _
6203' & "WHERE stationno = '" & stationno & "' " _
6204' & "AND shiftno = '" & shiftno & "' " _
6205' & "AND lupdatetime BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6206' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6207' & "ORDER BY transacno "
6208' Call modmain.rsConnection(rspos, strsql)
6209'
6210' If rspos.EOF = True Then
6211' MsgBox "No transaction for the Shift!", vbInformation, systemname
6212' Exit Sub
6213' Else
6214' While Not rspos.EOF
6215' strsql = "UPDATE tbl_T_charges " _
6216' & "SET reportflag = '1' ," _
6217' & "WHERE transacno = '" & rspos!transacno & "' "
6218' conn.Execute strsql
6219' strsql = "UPDATE tbl_T_orderdetails " _
6220' & "SET reportflag = '1' ," _
6221' & "WHERE transacno = '" & rspos!transacno & "' "
6222' conn.Execute strsql
6223'
6224' rspos.MoveNext
6225'
6226' rspos.Close
6227' End If
6228' '--- End Added 11/05/11 for BIR
6229'
6230 Call modmain.rsConnection(rspos, "SELECT * FROM tbl_T_charges " _
6231 & "WHERE stationno = '" & stationno & "' " _
6232 & "AND shiftno = '" & shiftno & "' " _
6233 & "AND lupdatetime BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6234 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6235 & "ORDER BY transacno")
6236 '--- Added by RHV for BIR Compliance 09/07/2011
6237 dblVATAmt = 0
6238 dblVATSales = 0
6239 dblVATExpSales = 0
6240 dblDiscSales = 0
6241 '---
6242
6243 If Not rspos.EOF = True Then
6244 For ctr = 1 To rspos.RecordCount
6245
6246 '--- Added by RHV for BIR Compliance 09/07/2011
6247 If IsNull(rspos!remarks) = True Then
6248 dblVATAmt = dblVATAmt + rspos!vat
6249 End If
6250 '---
6251
6252 If IsNull(rspos!remarks) = True Then
6253 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + rspos!transacno + ESC + "|N" + vbCrLf
6254 Else
6255 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + rspos!transacno + " " + rspos!remarks + ESC + "|N" + vbCrLf
6256 End If
6257
6258
6259 Call modmain.rsConnection(rspayment, "SELECT transacno,paymentmodeid,exactamount,reminder " _
6260 & "FROM tbl_T_payment " _
6261 & "WHERE transacno = '" & rspos!transacno & "' " _
6262 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6263 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6264
6265 '--- Added by RHV for BIR 11/07/2011
6266' strsql = "UPDATE tbl_T_payment " _
6267' & "SET reportflag = '1' ," _
6268' & "WHERE transacno = '" & rspos!transacno & "' "
6269' conn.Execute strsql
6270
6271 '--- End Added by RHV for BIR 11/07/2011
6272
6273 Dim reminder As String
6274 '--- Double Check first
6275
6276 If Not rspayment.EOF = True Then
6277 For ctr1 = 1 To rspayment.RecordCount
6278 Call modmain.rsConnection(rspaymentmode, "SELECT * FROM tbl_M_paymentmode " _
6279 & "WHERE paymentmodeid = '" & rspayment!paymentmodeid & "'")
6280 If Not rspaymentmode.EOF = True Then
6281 '---For VOID Bill/Return
6282 If rspayment!exactamount < 0 Then
6283 If IsNull(rspayment!reminder) = True Then
6284 reminder = ""
6285 Else
6286 reminder = rspayment!reminder
6287 End If
6288
6289 .PrintNormal PTR_S_RECEIPT, ESC + "|N" _
6290 + Space$(10) _
6291 + PadR(rspaymentmode!paymentmode, 6, " ") _
6292 + PadR(reminder, 7, " ") _
6293 + Format$(Format$(rspayment!exactamount, "#,##0.00"), "@@@@@@@@@@") _
6294 + ESC + "|N" + vbCrLf
6295 Else
6296 .PrintNormal PTR_S_RECEIPT, ESC + "|N" _
6297 + Space$(10) _
6298 + PadR(rspaymentmode!paymentmode, 13, " ") _
6299 + Format$(Format$(rspayment!exactamount, "#,##0.00"), "@@@@@@@@@@") _
6300 + ESC + "|N" + vbCrLf
6301 End If
6302 End If
6303 rspaymentmode.Close
6304
6305 Select Case rspayment!paymentmodeid
6306 Case 1:
6307 cashamt = cashamt + rspayment!exactamount
6308 Case 2:
6309 cardamt = cardamt + rspayment!exactamount
6310 Case 3:
6311 chargeamt = chargeamt + rspayment!exactamount
6312 Case 4:
6313 couponamt = couponamt + rspayment!exactamount
6314 End Select
6315 '--- Added by RHV for BIR Compliance 09/07/2011
6316 'If IsNull(rspos!remarks) = True Then
6317 'dblVATAmt = dblVATAmt + rspos!vat
6318 dblVATSales = dblVATSales + rspayment!exactamount
6319 'End If
6320 '---
6321
6322 rspayment.MoveNext
6323 Next ctr1
6324 End If
6325 rspayment.Close
6326
6327
6328
6329 rspos.MoveNext
6330 Next ctr
6331 End If
6332 rspos.Close
6333
6334 'Line
6335 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
6336
6337 .PrintNormal PTR_S_RECEIPT, ESC + "|bC" + ESC + "|2C" + "TOTAL" + ESC + "|N" + vbCrLf
6338
6339 'Payments
6340 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6341 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6342 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6343 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6344 'Line
6345 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
6346
6347 '--added by HSA for BIR Compliance Aug 11, 2012
6348 Dim totalvatexemptsales As Double
6349
6350 Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(vatexemptsales),0) as totalvatexemptsales " _
6351 & "FROM tbl_T_charges " _
6352 & "WHERE remarks is NULL and userid = '" & userloginid & "' " _
6353 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6354 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6355 totalvatexemptsales = rsOrderDet!totalvatexemptsales
6356 rsOrderDet.Close
6357
6358 Dim totalvatablesales As Double
6359
6360 Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(vatablesales),0) as totalvatablesales " _
6361 & "FROM tbl_T_charges " _
6362 & "WHERE remarks is NULL and userid = '" & userloginid & "' " _
6363 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6364 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6365 totalvatablesales = rsOrderDet!totalvatablesales
6366 rsOrderDet.Close
6367
6368 '--- Added by RHV for BIR Compliance 09/07/2011
6369' Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(finalprice),0) as finalprice " _
6370' & "FROM tbl_T_orderdetail " _
6371' & "WHERE vatableitem <> 1 and userid = '" & userloginid & "' " _
6372' & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6373' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6374' dblNonVATExpSales = rsOrderDet!finalprice
6375' rsOrderDet.Close
6376'
6377' Call modmain.rsConnection(rsOrderDet1, "SELECT sum(a.FinalPrice) as finalprice " _
6378' & "FROM tbl_T_orderdetail a inner join tbl_M_stocklibrary b on a.stockid = b.stockid " _
6379' & "WHERE b.seniorcitizen = 1 and a.discinfoid = 1 and a.finalprice <> 0 and a.userid = '" & userloginid & "' " _
6380' & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6381' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6382' If rsOrderDet1.EOF Then
6383' dblVATExpSales = 0
6384' Else
6385' dblVATExpSales = Round(IIf(IsNull(rsOrderDet1!finalprice), "0", rsOrderDet1!finalprice) / (1 + vatrate), 2)
6386' End If
6387' rsOrderDet1.Close
6388'
6389' Call modmain.rsConnection(rsOrderDet2, "Select distinct a.transacno, a.discountamount as DiscountAmount " _
6390' & "FROM tbl_T_chargesdiscount a inner join tbl_T_orderdetail b on a.transacno = b.transacno " _
6391' & "inner join tbl_M_stocklibrary c on b.stockid = c.stockid " _
6392' & "WHERE c.seniorcitizen = 1 and b.discinfoid = 1 and b.finalprice <> 0 and b.userid = '" & userloginid & "' " _
6393' & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6394' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6395' If rsOrderDet2.EOF Then
6396' dblDiscSales = 0
6397' Else
6398' For i = 1 To rsOrderDet2.RecordCount
6399' dblDiscSales = IIf(IsNull(rsOrderDet2!discountamount), "0", rsOrderDet2!discountamount) + dblDiscSales
6400' rsOrderDet2.MoveNext
6401' Next i
6402' End If
6403' rsOrderDet2.Close
6404'
6405' Call modmain.rsConnection(rsOrderDet1, "SELECT sum(a.FinalPrice) as finalprice " _
6406' & "FROM tbl_T_orderdetail a inner join tbl_M_stocklibrary b on a.stockid = b.stockid " _
6407' & "WHERE b.seniorcitizen = 1 and a.userid = '" & userloginid & "' " _
6408' & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6409' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6410' If rsOrderDet1.EOF Then
6411' dblVATableSales = 0
6412' Else
6413' dblVATableSales = IIf(IsNull(rsOrderDet1!finalprice), "0", rsOrderDet1!finalprice) / 1 + vatrate
6414' End If
6415' rsOrderDet1.Close
6416
6417 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT AMT", 23, " ") + Format$(Format$(dblVATAmt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6418 ' .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(dblVATSales - dblNonVATExpSales - dblVATExpSales + dblDiscSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6419 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(totalvatablesales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6420 '.PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXMPT SALES", 23, " ") + Format$(Format$(dblVATExpSales - dblDiscSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6421 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXMPT SALES", 23, " ") + Format$(Format$(totalvatexemptsales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6422 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("NON VAT SALES", 23, " ") + Format$(Format$(dblNonVATExpSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6423 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT ZERO-RTD SALES", 23, " ") + Format$(Format$(0, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6424 '---End Added by RHV for BIR Compliance 09/07/2011
6425
6426 'Feed the receipt to the cutter position automatically, and cut.
6427 ' ESC|#fP = Line Feed and Paper cut
6428 .PrintNormal PTR_S_RECEIPT, ESC + "|fP"
6429
6430
6431 End With
6432
6433 Next printerctr
6434
6435 Screen.MousePointer = vbDefault
6436
6437End Sub
6438'----For BIR X Reading
6439Sub printxreadingBIR()
6440
6441 Screen.MousePointer = vbHourglass
6442
6443 Dim ESC As String * 1
6444 Dim printdatetime As String
6445
6446 'Initialization
6447 ESC = Chr(&H1B) 'ESC command
6448 printdatetime = Format(Now, "mm/dd/yyyy hh:mm:ssAM/PM") 'system date
6449
6450 Call modmain.rsConnection(rspos, "SELECT shiftstart,shiftend FROM tbl_T_shift " _
6451 & "WHERE posstation = '" & stationno & "' " _
6452 & "AND shiftno = '" & shiftno & "' AND statusid = 0")
6453 If Not rspos.EOF = True Then
6454 shiftstart = rspos!shiftstart
6455 shiftend = rspos!shiftend
6456 End If
6457 rspos.Close
6458 '---For testing only
6459 '---
6460 For printerctr = 1 To Val(noofcopies)
6461
6462 With OPOSPOSPrinter1
6463 'Header
6464 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "DALUNAN MANAGEMENT SERVICES" + vbCrLf
6465 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "24/7 QUICKMART" + vbCrLf
6466 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "GF FUENTE TOWER II" + vbCrLf
6467 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "OSME" + Chr$(165) + "A BOULEVARD CEBU CITY" + vbCrLf
6468 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "VAT REG TIN 903-740-466-005" + vbCrLf
6469 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "S/N: " + printerserialno + ESC + "|N" + vbCrLf
6470 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "MIN: " + vbCrLf
6471 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "eAccred: " + vbCrLf
6472
6473 'Line
6474 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf + vbCrLf
6475
6476 'Print X
6477 .PrintNormal PTR_S_RECEIPT, ESC + "|bC" + ESC + "|2C" + "X Reading" + ESC + "|N" + vbCrLf + vbCrLf
6478
6479 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "*********************************" + ESC + "|N" + vbCrLf
6480 .PrintNormal PTR_S_RECEIPT, ESC + "|cA" + "SHIFT END REPORT" + ESC + "|N" + vbCrLf
6481 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "*********************************" + ESC + "|N" + vbCrLf
6482
6483 'Date and POS Station
6484 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + printdatetime + Space$(2) + "POS Stn: " + stationno + ESC + "|N" + vbCrLf
6485
6486 'Cashier
6487 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + "Cashier: " + UCase(mainform.StatusBar1.Panels(2).Text) + ESC + "|N" + vbCrLf + vbCrLf
6488
6489 Call usevariables
6490 '-- Remove below
6491 'shiftstart = "09/01/2011 06:00:00 am"
6492 'shiftend = "09/01/2011 14:00:00 am"
6493 'shiftno = "1"
6494 'stationno = "1"
6495 '-------------
6496 '---Added 11/05/11 for BIR
6497 strsql = "Select * " _
6498 & "FROM tbl_T_charges " _
6499 & "WHERE stationno = '" & stationno & "' " _
6500 & "AND shiftno = '" & shiftno & "' " _
6501 & "AND lupdatetime BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6502 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6503 & "AND Reportflag = '1' " _
6504 & "ORDER BY transacnobir "
6505
6506 'Call modmain.rsConnection(rspos, "SELect * FROM tbl_T_charges " _
6507 ' & "WHERE stationno = '" & stationno & "' " _
6508 ' & "AND shiftno = '" & shiftno & "' " _
6509 ' & "AND lupdatetime BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6510 ' & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6511 ' & "ORDER BY transacno")
6512 Call modmain.rsConnection(rspos, strsql)
6513 '--- End Added 11/05/11 for BIR
6514
6515 '--- Added by RHV for BIR Compliance 09/07/2011
6516
6517 dblVATAmt = 0
6518 dblVATSales = 0
6519 dblVATExpSales = 0
6520 dblDiscSales = 0
6521 '---
6522
6523 If Not rspos.EOF = True Then
6524 For ctr = 1 To rspos.RecordCount
6525
6526 '--- Added by RHV for BIR Compliance 09/07/2011
6527 If IsNull(rspos!remarks) = True Then
6528 dblVATAmt = dblVATAmt + rspos!vat
6529 End If
6530 '---
6531
6532 If IsNull(rspos!remarks) = True Then
6533 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + rspos!transacnoBIR + ESC + "|N" + vbCrLf
6534 Else
6535 .PrintNormal PTR_S_RECEIPT, ESC + "|N" + rspos!transacnoBIR + " " + rspos!remarks + ESC + "|N" + vbCrLf
6536 End If
6537
6538 'Call modmain.rsConnection(rspayment, "SELECT transacno,paymentmodeid,exactamount " _
6539 ' & "FROM tbl_T_payment " _
6540 ' & "WHERE transacno = '" & rspos!transacno & "' " _
6541 ' & "AND cancelled = 0")
6542
6543 Call modmain.rsConnection(rspayment, "SELECT transacnobir,paymentmodeid,exactamount,reminder " _
6544 & "FROM tbl_T_payment " _
6545 & "WHERE transacnoBIR = '" & rspos!transacnoBIR & "' " _
6546 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6547 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6548 Dim reminder As String
6549 '--- Double Check first
6550 If Not rspayment.EOF = True Then
6551 For ctr1 = 1 To rspayment.RecordCount
6552 Call modmain.rsConnection(rspaymentmode, "SELECT * FROM tbl_M_paymentmode " _
6553 & "WHERE paymentmodeid = '" & rspayment!paymentmodeid & "'")
6554 If Not rspaymentmode.EOF = True Then
6555 '---For VOID Bill/Return
6556 If rspayment!exactamount < 0 Then
6557 If IsNull(rspayment!reminder) = True Then
6558 reminder = ""
6559 Else
6560 reminder = rspayment!reminder
6561 End If
6562
6563 .PrintNormal PTR_S_RECEIPT, ESC + "|N" _
6564 + Space$(10) _
6565 + PadR(rspaymentmode!paymentmode, 6, " ") _
6566 + PadR(reminder, 7, " ") _
6567 + Format$(Format$(rspayment!exactamount, "#,##0.00"), "@@@@@@@@@@") _
6568 + ESC + "|N" + vbCrLf
6569 Else
6570 .PrintNormal PTR_S_RECEIPT, ESC + "|N" _
6571 + Space$(10) _
6572 + PadR(rspaymentmode!paymentmode, 13, " ") _
6573 + Format$(Format$(rspayment!exactamount, "#,##0.00"), "@@@@@@@@@@") _
6574 + ESC + "|N" + vbCrLf
6575 End If
6576
6577 End If
6578 rspaymentmode.Close
6579
6580 Select Case rspayment!paymentmodeid
6581 Case 1:
6582 cashamt = cashamt + rspayment!exactamount
6583 Case 2:
6584 cardamt = cardamt + rspayment!exactamount
6585 Case 3:
6586 chargeamt = chargeamt + rspayment!exactamount
6587 Case 4:
6588 couponamt = couponamt + rspayment!exactamount
6589 End Select
6590 '--- Added by RHV for BIR Compliance 09/07/2011
6591 'If IsNull(rspos!remarks) = True Then
6592 'dblVATAmt = dblVATAmt + rspos!vat
6593 dblVATSales = dblVATSales + rspayment!exactamount
6594 'End If
6595 '---
6596
6597 rspayment.MoveNext
6598 Next ctr1
6599 End If
6600 rspayment.Close
6601
6602
6603
6604 rspos.MoveNext
6605 Next ctr
6606 End If
6607 rspos.Close
6608
6609 'Line
6610 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
6611
6612 .PrintNormal PTR_S_RECEIPT, ESC + "|bC" + ESC + "|2C" + "TOTAL" + ESC + "|N" + vbCrLf
6613
6614 'Payments
6615 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CASH", 23, " ") + Format$(Format$(cashamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6616 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CARD", 23, " ") + Format$(Format$(cardamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6617 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("CHARGE", 23, " ") + Format$(Format$(chargeamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6618 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("COUPON", 23, " ") + Format$(Format$(couponamt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6619 'Line
6620 .PrintNormal PTR_S_RECEIPT, ESC + "|uC" + Space$(33) + ESC + "|N" + vbCrLf
6621
6622 '--added by HSA for BIR Compliance Aug 11, 2012
6623 Dim totalvatexemptsales As Double
6624
6625 Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(vatexemptsales),0) as totalvatexemptsales " _
6626 & "FROM tbl_T_charges " _
6627 & "WHERE remarks is NULL and userid = '" & userloginid & "' " _
6628 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6629 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6630 totalvatexemptsales = rsOrderDet!totalvatexemptsales
6631 rsOrderDet.Close
6632
6633 Dim totalvatablesales As Double
6634
6635 Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(vatablesales),0) as totalvatablesales " _
6636 & "FROM tbl_T_charges " _
6637 & "WHERE remarks is NULL and userid = '" & userloginid & "' " _
6638 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6639 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6640 totalvatablesales = rsOrderDet!totalvatablesales
6641 rsOrderDet.Close
6642 '------------------------------------
6643 '--- Added by RHV for BIR Compliance 09/07/2011
6644 Call modmain.rsConnection(rsOrderDet, "SELECT isnull(sum(finalprice),0) as finalprice " _
6645 & "FROM tbl_T_orderdetail " _
6646 & "WHERE vatableitem <> 1 and userid = '" & userloginid & "' and Reportflag = '1' " _
6647 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6648 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6649 dblNonVATExpSales = rsOrderDet!finalprice
6650 rsOrderDet.Close
6651
6652 Call modmain.rsConnection(rsOrderDet1, "SELECT sum(a.FinalPrice) as finalprice " _
6653 & "FROM tbl_T_orderdetail a inner join tbl_M_stocklibrary b on a.stockid = b.stockid " _
6654 & "WHERE b.seniorcitizen = 1 and (a.discinfoid = 1 or a.discinfoid = 16) and a.finalprice <> 0 and a.userid = '" & userloginid & "' and a.Reportflag = '1' " _
6655 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6656 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6657 If rsOrderDet1.EOF Then
6658 dblVATExpSales = 0
6659 Else
6660 dblVATExpSales = Round(IIf(IsNull(rsOrderDet1!finalprice), "0", rsOrderDet1!finalprice) / (1 + vatrate), 2)
6661 End If
6662 rsOrderDet1.Close
6663
6664 Call modmain.rsConnection(rsOrderDet2, "Select distinct a.transacno, a.discountamount as DiscountAmount " _
6665 & "FROM tbl_T_chargesdiscount a inner join tbl_T_orderdetail b on a.transacno = b.transacno " _
6666 & "inner join tbl_M_stocklibrary c on b.stockid = c.stockid " _
6667 & "WHERE c.seniorcitizen = 1 and (b.discinfoid = 1 or b.discinfoid = 16) and b.finalprice <> 0 and b.userid = '" & userloginid & "' and b.Reportflag = '1' " _
6668 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6669 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6670 If rsOrderDet2.EOF Then
6671 dblDiscSales = 0
6672 Else
6673 For i = 1 To rsOrderDet2.RecordCount
6674 dblDiscSales = IIf(IsNull(rsOrderDet2!discountamount), "0", rsOrderDet2!discountamount) + dblDiscSales
6675 rsOrderDet2.MoveNext
6676 Next i
6677 End If
6678 rsOrderDet2.Close
6679
6680 Call modmain.rsConnection(rsOrderDet1, "SELECT sum(a.FinalPrice) as finalprice " _
6681 & "FROM tbl_T_orderdetail a inner join tbl_M_stocklibrary b on a.stockid = b.stockid " _
6682 & "WHERE b.seniorcitizen = 1 and a.userid = '" & userloginid & "' and a.Reportflag = '1' " _
6683 & "AND datetimetrx BETWEEN '" & Format(shiftstart, "mm/dd/yyyy hh:mm:ss AM/PM") & "' " _
6684 & "AND '" & Format(shiftend, "mm/dd/yyyy hh:mm:ss AM/PM") & "' ")
6685 If rsOrderDet1.EOF Then
6686 dblVATableSales = 0
6687 Else
6688 dblVATableSales = IIf(IsNull(rsOrderDet1!finalprice), "0", rsOrderDet1!finalprice) / 1 + vatrate
6689 End If
6690 rsOrderDet1.Close
6691
6692
6693 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT AMT", 23, " ") + Format$(Format$(dblVATAmt, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6694 ' .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(dblVATSales - dblNonVATExpSales - dblVATExpSales + dblDiscSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6695 ' .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXMPT SALES", 23, " ") + Format$(Format$(dblVATExpSales - dblDiscSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6696 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VATABLE SALES", 23, " ") + Format$(Format$(totalvatablesales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6697 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT EXMPT SALES", 23, " ") + Format$(Format$(totalvatexemptsales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6698
6699
6700 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("NON VAT SALES", 23, " ") + Format$(Format$(dblNonVATExpSales, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6701 .PrintNormal PTR_S_RECEIPT, ESC + "N" + PadR("VAT ZERO-RTD SALES", 23, " ") + Format$(Format$(0, "#,##0.00"), "@@@@@@@@@@") + ESC + "|N" + vbCrLf
6702 '---End Added by RHV for BIR Compliance 09/07/2011
6703
6704 'Feed the receipt to the cutter position automatically, and cut.
6705 ' ESC|#fP = Line Feed and Paper cut
6706 .PrintNormal PTR_S_RECEIPT, ESC + "|fP"
6707
6708
6709 End With
6710
6711 Next printerctr
6712
6713 Screen.MousePointer = vbDefault
6714
6715End Sub
6716'----End BIR X Reading ---------
6717Private Sub cmdReturn_Click()
6718
6719 LogInfo "Return Button Clicked"
6720 If frapayment.Visible = True Then
6721 MsgBox "You are currently transacting a payment." _
6722 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6723 cbopaymentmode.SetFocus
6724 Exit Sub
6725
6726 ElseIf frarecall.Visible = True Then
6727 MsgBox "You are currently recalling a transaction." _
6728 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6729 lstrecall.SetFocus
6730 Exit Sub
6731
6732 ElseIf lblaction.Visible = True Then
6733 If lblaction.Caption = "Choose an item." Then
6734 MsgBox "You are currently choosing an item." _
6735 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6736 txtbarcode.SetFocus
6737 Exit Sub
6738
6739 ElseIf lblaction.Caption = "Select an item to edit." Then
6740 MsgBox "You are currently selecting an item to edit." _
6741 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6742 lvworder.SetFocus
6743 Exit Sub
6744
6745 ElseIf lblaction.Caption = "Quantity" Then
6746 MsgBox "You are currently editing an item." _
6747 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6748 txtaction.SetFocus
6749 Exit Sub
6750
6751 ElseIf lblaction.Caption = "Select an item to delete." Then
6752 MsgBox "You are currently selecting an item to delete." _
6753 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6754 lvworder.SetFocus
6755 Exit Sub
6756
6757 ElseIf lblaction.Caption = "Suspension Tag" Then
6758 MsgBox "You are currently suspending an order." _
6759 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6760 lvworder.SetFocus
6761 Exit Sub
6762
6763 ElseIf lblaction.Caption = "Total Charges" Then
6764 MsgBox "You are currently doing a transaction." _
6765 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6766 Exit Sub
6767
6768 End If
6769 End If
6770 securityprocno = 13
6771 frapassword.Visible = True
6772 txtposuser.Text = ""
6773 txtpospass.Text = ""
6774 Call enabledisable(False)
6775 txtposuser.SetFocus
6776
6777End Sub
6778Private Sub cmdvoid_Click()
6779
6780 LogInfo "Void Button Clicked"
6781 If frapayment.Visible = True Then
6782 MsgBox "You are currently transacting a payment." _
6783 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6784 cbopaymentmode.SetFocus
6785 Exit Sub
6786
6787 ElseIf frarecall.Visible = True Then
6788 MsgBox "You are currently recalling a transaction." _
6789 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6790 lstrecall.SetFocus
6791 Exit Sub
6792
6793 ElseIf lblaction.Visible = True Then
6794 If lblaction.Caption = "Choose an item." Then
6795 MsgBox "You are currently choosing an item." _
6796 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6797 txtbarcode.SetFocus
6798 Exit Sub
6799
6800 ElseIf lblaction.Caption = "Select an item to edit." Then
6801 MsgBox "You are currently selecting an item to edit." _
6802 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6803 lvworder.SetFocus
6804 Exit Sub
6805
6806 ElseIf lblaction.Caption = "Quantity" Then
6807 MsgBox "You are currently editing an item." _
6808 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6809 txtaction.SetFocus
6810 Exit Sub
6811
6812 ElseIf lblaction.Caption = "Select an item to delete." Then
6813 MsgBox "You are currently selecting an item to delete." _
6814 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6815 lvworder.SetFocus
6816 Exit Sub
6817
6818 ElseIf lblaction.Caption = "Suspension Tag" Then
6819 MsgBox "You are currently suspending an order." _
6820 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6821 lvworder.SetFocus
6822 Exit Sub
6823
6824 ElseIf lblaction.Caption = "Total Charges" Then
6825 MsgBox "You are currently doing a transaction." _
6826 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6827 Exit Sub
6828
6829 End If
6830 End If
6831 securityprocno = 11
6832 frapassword.Visible = True
6833 txtposuser.Text = ""
6834 txtpospass.Text = ""
6835 Call enabledisable(False)
6836 txtposuser.SetFocus
6837End Sub
6838
6839Private Sub cmdreprint_Click()
6840
6841 LogInfo "Reprint Button Clicked"
6842 If frapayment.Visible = True Then
6843 MsgBox "You are currently transacting a payment." _
6844 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6845 cbopaymentmode.SetFocus
6846 Exit Sub
6847
6848 ElseIf frarecall.Visible = True Then
6849 MsgBox "You are currently recalling a transaction." _
6850 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6851 lstrecall.SetFocus
6852 Exit Sub
6853
6854 ElseIf lblaction.Visible = True Then
6855 If lblaction.Caption = "Choose an item." Then
6856 MsgBox "You are currently choosing an item." _
6857 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6858 txtbarcode.SetFocus
6859 Exit Sub
6860
6861 ElseIf lblaction.Caption = "Select an item to edit." Then
6862 MsgBox "You are currently selecting an item to edit." _
6863 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6864 lvworder.SetFocus
6865 Exit Sub
6866
6867 ElseIf lblaction.Caption = "Quantity" Then
6868 MsgBox "You are currently editing an item." _
6869 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6870 txtaction.SetFocus
6871 Exit Sub
6872
6873 ElseIf lblaction.Caption = "Select an item to delete." Then
6874 MsgBox "You are currently selecting an item to delete." _
6875 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6876 lvworder.SetFocus
6877 Exit Sub
6878
6879 ElseIf lblaction.Caption = "Suspension Tag" Then
6880 MsgBox "You are currently suspending an order." _
6881 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6882 lvworder.SetFocus
6883 Exit Sub
6884
6885 ElseIf lblaction.Caption = "Total Charges" Then
6886 MsgBox "You are currently doing a transaction." _
6887 & vbCrLf & "Execute Cancel or Press ESC, before exiting the " & systemname & ".", vbCritical, systemname
6888 Exit Sub
6889
6890 End If
6891 End If
6892 securityprocno = 12
6893 frapassword.Visible = True
6894 txtposuser.Text = ""
6895 txtpospass.Text = ""
6896 Call enabledisable(False)
6897 txtposuser.SetFocus
6898End Sub