REM *************** For Scrollable lists, this is a good model ******
REM *********** Found to be the best on 11th November, 1997 07.45 hrs ***
REM ********* Right upto saving in lsy and muritm everything seems ok ***********
KEY(31) ON
ON KEY(31) GOSUB 400
COLOR 26, 0
LOCATE 24, 2
PRINT "Message : The Message below holds good for the entire Program !"
COLOR 10, 0
LOCATE 25, 2
PRINT "Message : Press <F12 + Enter> key to Abandon the procedure and Exit..."

OPEN "D:\16699bln.dat" FOR INPUT AS #1
DO WHILE NOT EOF(1)
    REM INPUT #1, receiptno$, medblno$
    REM INPUT #1, receiptno$
    INPUT #1, medblno$
LOOP
CLOSE #1
medblno$ = STR$(VAL(medblno$) + 1)
patname$ = ""
today$ = ""

25 CLS
LOCATE 25, 2
PRINT "Message : Press <F12 + Enter> key to Abandon the procedure and Exit..."
LOCATE 4, 32
PRINT "MEDICINE BILL ENTRY"
LOCATE 10, 2
PRINT "Enter the Receipt No.       : "; LTRIM$(medblno$)
LOCATE 12, 2
PRINT "Enter today's date          : "; LTRIM$(today$)
LOCATE 14, 2
PRINT "Enter the Patient's name    : "; LTRIM$(patname$)

LOCATE 10, 2
LINE INPUT "Enter the Receipt No.       : "; medblno1$
LOCATE 12, 2
LINE INPUT "Enter today's date          : "; today1$
LOCATE 14, 2
LINE INPUT "Enter the Patient's name    : "; patname1$

IF LEN(medblno1$) > 0 THEN medblno$ = medblno1$
IF LEN(patname1$) > 0 THEN patname$ = patname1$
IF LEN(today1$) > 0 THEN today$ = today1$

LOCATE 20, 16
LINE INPUT "DO YOU WANT TO MAKE ANY CHANGES ABOVE (Y/N) : ", answer$
IF UCASE$(answer$) = "Y" THEN GOTO 25

dupl = 0
selslno = 0
OPEN "d:\\16699cst.dat" FOR INPUT AS #1
OPEN "d:\\16699csc.dat" FOR OUTPUT AS #2
DO WHILE NOT EOF(1)
    INPUT #1, slno, type$, name$, comp$, rate
    quan = 0!
    itmamt = 0!
    WRITE #2, slno, type$, name$, comp$, rate, quan, itmamt
    dupl = dupl + 1
LOOP
CLOSE #1
CLOSE #2

down$ = CHR$(0) + CHR$(80)
up$ = CHR$(0) + CHR$(72)
return$ = CHR$(13)
esc$ = CHR$(27)
ra$ = CHR$(0) + CHR$(77)
la$ = CHR$(0) + CHR$(75)
del$ = CHR$(0) + CHR$(83)

DIM slno(dupl), type$(dupl), name$(dupl), comp$(dupl), rate(dupl), quan(dupl), itmamt(dupl)
DIM mslno(dupl), mtype$(dupl), mname$(dupl), mcomp$(dupl), mrate(dupl), mquan(dupl), mitmamt(dupl)
DIM selslno(dupl)
CLS
OPEN "d:\\16699csc.dat" FOR INPUT AS #1
counter = 0
FOR counter = 0 TO (dupl - 1)
    INPUT #1, slno(counter), type$(counter), name$(counter), comp$(counter), rate(counter), quan(counter), itmamt(counter)
NEXT counter
CLOSE #1

CLS
LOCATE 12, 5
INPUT "  Enter the first letter of the name of the medicine you want :  ", mednam$

100
CLS
COLOR 10, 0
row = 4
dupl2 = 0
selslno = 0
FOR dupl1 = 0 TO (dupl - 1)
    IF UCASE$(MID$(name$(dupl1), 1, 1)) = UCASE$(mednam$) THEN 'AND quan(dupl1) = 0 THEN
        IF quan(dupl1) = 0 THEN
            mslno(dupl2) = slno(dupl1)
            mtype$(dupl2) = type$(dupl1)
            mname$(dupl2) = name$(dupl1)
            mcomp$(dupl2) = comp$(dupl1)
            mrate(dupl2) = rate(dupl1)
            mquan(dupl2) = quan(dupl1)
            mitmamt(dupl2) = itmamt(dupl1)
            IF mslno(dupl2) > 0 AND row <= 20 THEN
                LOCATE row, 1
                PRINT TAB(10); mslno(dupl2); TAB(15); mtype$(dupl2); TAB(20); mname$(dupl2); TAB(70); mquan(dupl2)
                row = row + 1
            END IF
            dupl2 = dupl2 + 1
        END IF
    END IF
NEXT dupl1

GOSUB 350

'200
finslno = 0
medbltot = 0
LPRINT CHR$(27) + "p1"
LPRINT CHR$(27) + "G"
LPRINT CHR$(27) + "E"
LPRINT CHR$(27) + "W1"
LPRINT TAB(13); "SENTHIL MEDICALS"
REM LPRINT CHR$(27); "0"; CHR$(120);
REM LPRINT CHR$(27); "0"; CHR$(120);
LPRINT CHR$(27) + "p0" + CHR$(27) + "H" + CHR$(27) + "F" + CHR$(27) + "W0"
LPRINT CHR$(27) + "M" + CHR$(15) + CHR$(27) + "W1" + CHR$(27) + "p1"
LPRINT "DL.No.:848/MZII/20   (Govt.Authorised Pharmacy)   DL.No.:848/MZII/21"
LPRINT "TNGST AREA CODE 052    64,'F',Anna Nagar East,    TNGST No.1022458"
LPRINT "                          Chennai-600 102."
LPRINT
LPRINT CHR$(27) + "p0"
LPRINT CHR$(27) + "M" + CHR$(18) + CHR$(27) + "W0"
LPRINT "                                  CASH RECEIPT"
LPRINT "                                  ------------"
LPRINT "C.R.No.:"; medblno$; TAB(66); "Date: "; today$
LPRINT patname$
LPRINT "-------------------------------------------------------------------"
LPRINT TAB(2); "S.No."; TAB(15); "ITEMS"; TAB(40); "QTY"; TAB(60); "AMOUNT"
LPRINT "--------------------------------------------------------------------"
FOR dupl1 = 0 TO (dupl - 1)
    IF quan(dupl1) > 0 THEN
        finslno = finslno + 1
        itmamt(dupl1) = quan(dupl1) * rate(dupl1)
        medbltot = medbltot + itmamt(dupl1)
        LPRINT TAB(2); finslno; TAB(6); "."; TAB(10); type$(dupl1); TAB(14); "."; TAB(16); name$(dupl1); TAB(40); quan(dupl1); TAB(60); USING "##,###.##"; itmamt(dupl1)
        PRINT TAB(2); finslno; TAB(6); "."; TAB(10); type$(dupl1); TAB(14); "."; TAB(16); name$(dupl1); TAB(40); quan(dupl1); TAB(60); USING "##,###.##"; itmamt(dupl1)
    END IF
NEXT dupl1
LPRINT "--------------------------------------------------------------------"
LPRINT "This Bill Total is                                Rs. "; TAB(60); USING "##,###.##"; medbltot
PRINT "This Bill Total is                                Rs. "; TAB(60); USING "##,###.##"; medbltot
LOCATE 20, 16
LINE INPUT "DO YOU WANT TO PROCEED (Y/N) : ", answer$
IF UCASE$(answer$) = "Y" THEN GOTO 220
'KEY(30) STOP
'ON KEY(30) GOSUB 220
'WAIT &H20, 1
220 LPRINT "--------------------------------------------------------------------"
LPRINT
REM print output$
LPRINT
LPRINT "Received Cash in full with thanks."
LPRINT
LPRINT
LPRINT "....................."
LPRINT "      Signature      "
LPRINT
LPRINT "E & OE. Goods once sold will not be taken back."
LPRINT
LPRINT
LPRINT "--------------------------------------------------------------------------------"
LPRINT
CLS
LOCATE 12, 20
prnyn$ = "N"
LINE INPUT "Do you want to store the data (Y/N) : "; prnyn$
IF UCASE$(prnyn$) = "Y" THEN
    CLS
    LOCATE 12, 12
    dchange$ = "N"
    LINE INPUT "Do you want to change the medicine bill amount (Y/N) : "; dchange$
    IF UCASE$(dchange$) = "Y" THEN
        CLS
        medbltot = 0
        COLOR 10, 0
        row = 4
        dupl2 = 0
        FOR dupl1 = 0 TO (dupl - 1)
            IF quan(dupl1) > 0 THEN
                mslno(dupl2) = slno(dupl1)
                mtype$(dupl2) = type$(dupl1)
                mname$(dupl2) = name$(dupl1)
                mquan(dupl2) = quan(dupl1)
                IF mslno(dupl2) > 0 AND row <= 20 THEN
                    LOCATE row, 1
                    PRINT TAB(10); mslno(dupl2); TAB(20); mtype$(dupl2); TAB(30); mname$(dupl2); TAB(70); mquan(dupl2)
                    row = row + 1
                END IF
                dupl2 = dupl2 + 1
            END IF
        NEXT dupl1

        FOR dupl1 = 0 TO (dupl - 1)
            quan(dupl1) = 0
        NEXT dupl1

        GOSUB 350

        '300
        FOR dupl1 = 0 TO (dupl - 1)
            IF quan(dupl1) > 0 THEN
                itmamt(dupl1) = quan(dupl1) * rate(dupl1)
                medbltot = medbltot + itmamt(dupl1)
            END IF
        NEXT dupl1
    END IF

    dummy = 0

    OPEN "d:\\16699bln.dat" FOR OUTPUT AS #2
    WRITE #2, medblno$
    CLOSE #2

    OPEN "d:\\16699mur.dat" FOR APPEND AS #2
    WRITE #2, dummy, today$, "re", "c", "         ", "        ", medblno$, "        ", "mt", patname$, medbltot
    CLOSE #2

    OPEN "d:\\16699lsy.dat" FOR APPEND AS #2
    FOR dupl1 = 0 TO (dupl - 1)
        IF quan(dupl1) > 0 THEN
            WRITE #2, type$(dupl1), name$(dupl1), comp$(dupl1), quan(dupl1), itmamt(dupl1), dummy, "        ", "                     ", dummy
        END IF
    NEXT dupl1
    WRITE #2, "   ", "          ", "           ", dummy, dummy, medblno$, today$, patname$, medbltot
    CLOSE #2
END IF
'END IF
CLS
SYSTEM
END


350 recno = 0
first = 0
LOCATE 23, 10
COLOR 10, 0
PRINT "Press <Esc> key after entering all the quantity in this screen"
row = 4
COLOR 8, 7
LOCATE 4, 1
PRINT SPACE$(80)
LOCATE 4, 1
PRINT TAB(10); mslno(0); TAB(15); mtype$(0); TAB(20); mname$(0); TAB(70); mquan(0)
stri$ = ""
col = 70
DO WHILE tmp$ <> CHR$(27)
    tmp$ = INKEY$
    res$ = ""
    IF (tmp$ > CHR$(47) AND tmp$ < CHR$(58)) THEN
        IF col > 72 THEN
            LOCATE row, 70
            PRINT "   "
            stri$ = ""
            col = 70
        END IF
        stri$ = LTRIM$(stri$) + LTRIM$(tmp$)
        res$ = LTRIM$(stri$)
        COLOR 10, 0
        LOCATE row, col
        PRINT LTRIM$(tmp$)
        col = col + 1
        mquan(recno) = VAL(LTRIM$(res$))
    END IF
 
    IF tmp$ = down$ OR tmp$ = return$ THEN
        col = 70
        COLOR 10, 0
        LOCATE row, 1
        PRINT SPACE$(80)
        LOCATE row, 1
        PRINT TAB(10); mslno(recno); TAB(15); mtype$(recno); TAB(20); mname$(recno); TAB(70); mquan(recno)
        row = row + 1
        recno = recno + 1
        IF row > 20 AND mslno(recno) <> 0 THEN
            row = 3
            first = first + 1
            FOR dupl1 = first TO (dupl - 1)
                IF row <= 20 THEN
                    row = row + 1
                    LOCATE row, 1
                    PRINT TAB(10); mslno(dupl1); TAB(15); mtype$(dupl1); TAB(20); mname$(dupl1); TAB(70); mquan(dupl1)
                END IF
            NEXT dupl1
            LOCATE 21, 1
            PRINT SPACE$(80)
            row = 20
        END IF

        IF mslno(recno) = 0 THEN
            PLAY "l16o2bcd"
            recno = recno - 1
            row = row - 1
        END IF
        COLOR 8, 7
        LOCATE row, 1
        PRINT SPACE$(80)
        LOCATE row, 1
        PRINT TAB(10); mslno(recno); TAB(15); mtype$(recno); TAB(20); mname$(recno); TAB(70); mquan(recno)
        stri$ = ""
    END IF

    IF tmp$ = up$ THEN
        col = 70
        COLOR 10, 0
        LOCATE row, 1
        PRINT SPACE$(80)
        LOCATE row, 1
        PRINT TAB(10); mslno(recno); TAB(15); mtype$(recno); TAB(20); mname$(recno); TAB(70); mquan(recno)
        recno = recno - 1
        row = row - 1

        IF recno < 0 THEN
            PLAY "l16o2bcd"
            row = 4
            recno = 0
        ELSE
            IF row < 4 AND slno(recno) <> 0 THEN
                row = 3
                first = first - 1
                IF first < 0 THEN first = 0
                FOR dupl1 = first TO (dupl - 1)
                    IF row <= 20 THEN
                        row = row + 1
                        LOCATE row, 1
                        PRINT TAB(10); mslno(dupl1); TAB(15); mtype$(dupl1); mname$(dupl1); TAB(70); mquan(dupl1)
                    END IF
                NEXT dupl1
                row = 4
                LOCATE 21, 1
                PRINT SPACE$(80)
            END IF
        END IF

        COLOR 8, 7
        LOCATE row, 68
        PRINT "       "
        stri$ = ""
        LOCATE row, 1
        PRINT SPACE$(80)
        LOCATE row, 1
        PRINT TAB(10); mslno(recno); TAB(15); mtype$(recno); TAB(20); mname$(recno); TAB(70); mquan(recno)
    END IF
    IF UCASE$(tmp$) > CHR$(64) AND UCASE$(tmp$) < CHR$(91) THEN
        mednam$ = UCASE$(tmp$)
        CLS
        COLOR 10, 0
        FOR dupl1 = 0 TO (dupl - 1)
            IF mquan(dupl1) > 0 THEN
                FOR dupl2 = 0 TO (dupl - 1)
                    IF slno(dupl2) = mslno(dupl1) THEN quan(dupl2) = mquan(dupl1)
                NEXT dupl2
            END IF
        NEXT dupl1
        GOTO 100
    END IF
LOOP
FOR dupl1 = 0 TO (dupl - 1)
    IF mquan(dupl1) > 0 THEN
        FOR dupl2 = 0 TO (dupl - 1)
            IF slno(dupl2) = mslno(dupl1) THEN quan(dupl2) = mquan(dupl1)
        NEXT dupl2
    END IF
NEXT dupl1
tmp$ = ""
COLOR 10, 0
CLS
RETURN
REM ---------------

'COLOR 10, 0
'LOCATE 12, 1
'prsv$ = "N"
'INPUT "       Have you printed this patient's Bill already ? Y/N "; prsv$
'IF UCASE$(prsv$) = "Y" THEN
'GOTO 300
'ELSE
'GOTO 200
'END IF
REM--------------------

400 CLS
SYSTEM
RETURN