perm filename ACCT[FOO,LMM] blob sn#077063 filedate 1973-12-07 generic text, type T, neo UTF8
(FILECREATED " 8-SEP-73 12:32:15" ACCT)


  (LISPXPRINT (QUOTE ACCTVARS)
              T)
  (RPAQQ ACCTVARS
         ((FNS ADDTO DOACCT SETNAMES PRINTAMT SPLIT GETSPLIT DOACCT1 
               FIXNAME FIXAMT FIXFOR PRINFINAL FIXSPLIT FF FONTSELECT 
               GETNAMES PRINTENTRIES PRINTSUBTOTALS PRINTSHEET)
          [VARS (ACCTDATVARS (QUOTE ((VARS FORS ACCTS NAMES 
                                           STANDARDSPLIT)
                                     (PROP SPLIT * FORS]
          RUB DOWNARROW))
(DEFINEQ

(ADDTO
  [LAMBDA (L N1 N2 V)

          (* L is an alist of alists -- insert V under N2 
          under N1)


    (PROG (P Q)
          (IF }(P←(ASSOC N1 L NIL))
              THEN L← <P← <N1> ! L>)
          (IF }(Q←(ASSOC N2 P::1))
              THEN (P::1←<Q← <N2> ! P::1>))
          (<!! Q V>)
          (RETURN L])

(DOACCT
  [LAMBDA (INLIST)
    (PROG (LIST1 TOTAL FINALIST)
          (GETNAMES)
          (DOACCT1 INLIST)
          (PRINTENTRIES LIST1)                  (* Now the list looks 
                                                like (NAME . AMT))
          (FF)
          (PRINTSUBTOTALS LIST1)
          (INLIST←NIL)
          (FOR FORL IN LIST1
             DO (FOR NAMEL IN FORL::2
                   DO INLIST←(ADDTO INLIST NAMEL:1 FORL:1 <'SPENT
                                                            NAMEL::1>))
       α        (FOR NAMEL IN FORL:2
                   DO INLIST←(ADDTO INLIST NAMEL:1 FORL:1 <'OWE 
                                                          NAMEL::1>)))
          (FOR X IN INLIST DO PRINTSHEET)
          (FF)
          (PRINFINAL FINALIST)
          (RETURN FINALIST])

(SETNAMES
  [LAMBDA (L)
    NAMES←L])

(PRINTAMT
  [LAMBDA (NUM TERPRIFLG)
    (PROG (Y)
          (SPACES 5-(NCHARS Y←NUM/100))
          (PRIN1 Y)
          (PRIN1 ".")
          (NUM←(IREMAINDER NUM 100))
          (IF MINUSP NUM
              THEN NUM←-NUM)
          (IF NUM LT 10
              THEN (PRIN1 "0"))
          (PRIN1 NUM)
          (IF TERPRIFLG
              THEN (TERPRI])

(SPLIT
  [LAMBDA (TYPE TOTAL)
    (PROG (SPLIT TOT)
          (SPLIT←([FIXSPLIT (OR (AND (MEMB TYPE NAMES)
                                     SPLIT← <<TYPE ! 1>>)
                                (GETP TYPE 'SPLIT)
                                (PROGN (PRIN1 TYPE T)
                                       (PRIN1 " SPLIT?" T)
                                       (PUT TYPE 'SPLIT (READ T]
               OR (HELP "INVALID SPLIT")))
          (TOT←0)
          (FOR N IN SPLIT DO TOT←TOT+N::1)
          (RETURN (FOR N IN SPLIT COLLECT <N:1 ! (TOTAL*N::1+TOT/2)
                                               /TOT>])

(GETSPLIT
  [LAMBDA (FOR)
    (GETP FOR 'SPLIT])

(DOACCT1
  [LAMBDA (INLIST)
    (PROG (NAME FOR AMT COMMENTS)
      LP  [IF INLIST
              THEN (IF NAME←(FIXNAME INLIST:1:1) AND FOR←(FIXFOR 
                                                         INLIST:1:2)
                         AND AMT←(FIXAMT INLIST:1:3)
                       THEN COMMENTS←INLIST:1::3
                            INLIST:1←<NAME FOR (FQUOTIENT AMT 100) ! 
                                               COMMENTS> 
                                               INLIST←INLIST::1
                     ELSE (PRIN1 "EDIT
" T) INLIST←(CAR (LAST (EDITL <INLIST:1 INLIST> NIL NIL INLIST:1)))
                          (GO LP))
            ELSE (NLSETQ (PROG NIL
                           NAMLP
                               (PRIN1 "WHO? " T)
                               (IF }(NAME←(READ T))
                                   THEN RETURN NIL)
                               (IF }(FIXNAME NAME)
                                   THEN GO NAMLP)
                           FORLP
                               (PRIN1 "FOR? " T)
                               (FOR←((FIXFOR (READ T))
                                    OR (GO FORLP)))
                           AMTLP
                               (PRIN1 "AMT? " T)
                               (IF }(AMT←(FIXAMT (READ T)))
                                   THEN GO AMTLP)
                               (CLBUFS)
                               (PRIN1 "REMARKS? " T)
                           COMMENTLP
                               (WHILE (PEEKC T) FMEMB '% 
                                  DO (READC T))
                               (COMMENTS←(READLINE]
          (IF }NAME
              THEN RETURN LIST1)
          (LIST1←(ADDTO LIST1 FOR NAME <AMT ! COMMENTS>))
          (GO LP])

(FIXNAME
  [LAMBDA (NAME)
    (OR (MISSPELLED? NAME 70 NAMES)
        (MISSPELLED? (PACK <NAME "≠" >)
                     70 NAMES)
        (AND (PROGN (PRIN1 NAME)
                    (PRIN1 " NEW PERSON? " T)
                    (READ T))='Y (CAR (NAMES← <NAME ! NAMES>])

(FIXAMT
  [LAMBDA (N)
    (AND N←[NUMBERP (CAR (NLSETQ (EVAL N]
         (ITIMES N*100])

(FIXFOR
  [LAMBDA (FOR)
    (OR (MISSPELLED? FOR 70 FORS (FUNCTION GETSPLIT))
        (FIXNAME FOR)
        (AND [PUT FOR 'SPLIT (PROG (SPLIT)
                                   (PRIN1 FOR)
                                   (PRIN1 " SPLIT? " T)
                                   (SPLIT←(READ T))
                                   (IF SPLIT='-
                                       THEN RETURN STANDARDSPLIT)
                                   (RETURN (FIXSPLIT SPLIT]
             (CAR (FORS← <FOR ! FORS>])

(PRINFINAL
  [LAMBDA (FL)
    (FOR X IN FL DO (PRIN1 X:1) (TAB 30) (PRINTAMT X:2) (TERPRI])

(FIXSPLIT
  [LAMBDA (SPLIT)
    (AND (LISTP SPLIT)
         [EVERY SPLIT (FUNCTION (LAMBDA (X)
                    (AND (CAR (X:1←(MISSPELLED? X:1 70 NAMES)))
                         (NUMBERP X::1]
         SPLIT])

(FF
  [LAMBDA NIL
    (PRIN1 "
"])

(FONTSELECT
  [LAMBDA (N)
    (PRIN1 (CONCAT RUB DOWNARROW (CHARACTER N])

(GETNAMES
  [LAMBDA NIL
    [OR (LISTP (CAR 'NAMES))
        (PROGN (PRIN1 "NAMES? ")
               (SETNAMES (READ T]
    (IF STRINGP INLIST:1
        THEN BILLSDATE←INLIST:1
             INLIST←INLIST::1
      ELSE (/ATTACH (PROGN (PRIN1 "BILLS FOR (in quotes, please):" T)
                           (READ T))
                    INLIST)
           INLIST←INLIST::1])

(PRINTENTRIES
  [LAMBDA (LIST1)
    (FOR FORL IN LIST1 DO                       (* For each for type, 
                                                for each person, add up 
                                                the totals SPENT)
                          (FOR NAMEL IN FORL::1
                             DO (TERPRI) (PRIN1 NAMEL:1) (PRIN1 
                                                         "  ----> ")
                                (PRIN1 (OR (GETP FORL:1 'NAME)
                                           FORL:1))
                                TOTAL←0
                                (FOR AD IN NAMEL::1
                                   DO (TERPRI)
                                      (FOR X IN AD::1
                                         DO (PRIN1 X) (SPACES 1))
                                      (TAB 41)
                                      (PRINTAMT AD:1) TOTAL←TOTAL+AD:1)
                                (TAB 41)
                                (PRIN1 "--------")
                                (TAB 41)
                                (PRINTAMT TOTAL T) NAMEL::1←TOTAL])

(PRINTSUBTOTALS
  [LAMBDA (LIST1)
    (FOR FORL IN LIST1 DO TOTAL←0
                          (IF FORL::2=NIL
                              THEN TOTAL←FORL:2::1
                            ELSE (PRIN1 FORL:1) (PRIN1 ":
") (FOR NAMEL IN FORL::1 DO (PRIN1 NAMEL:1) TOTAL←TOTAL+NAMEL::1
                            (TAB 20)
                            (PRINTAMT NAMEL::1 T))
                                 (PRIN1 "               -------------
")
                                 (TAB 20)
                                 (PRINTAMT TOTAL T)
                                 (TERPRI))
                          FORL::1← <(SPLIT FORL:1 TOTAL)
                                     ! FORL::1>])

(PRINTSHEET
  [LAMBDA (NAME.ENTRIES)
    (PROG ((OWE 0)
           (SPENT 0))
          (FF)
          (FONTSELECT 1)
          (PRIN1 "			The Alameda House")
          (RPTQ 4 (TERPRI))
          (FONTSELECT 4)
          (PRIN1 "Statement for ")
          (PRIN1 BILLSDATE)
          (RPTQ 4 (TERPRI))
          (FONTSELECT 3)
          (PRIN1 NAME.ENTRIES:1)
          (PRIN1 ":")
          (FONTSELECT 0)
          (TERPRI)
          (FOR FORL IN NAME.ENTRIES::1 DO (SPACES 1) (PRIN1 FORL:1)
                                          (IF TEM←(ASSOC 'SPENT FORL::1)
                                              THEN (TAB 10)
                                                   (PRINTAMT TEM:2) 
                                                  SPENT←SPENT+TEM:2)
                                          (IF TEM←(ASSOC 'OWE FORL::1)
                                              THEN (TAB 30)
                                                   (PRINTAMT TEM:2) 
                                                   OWE←OWE+TEM:2)
                                          (TERPRI))
          (TAB 10)
          (PRIN1 "--------")
          (TAB 30)
          (PRIN1 "---------")
          (TERPRI)
          (TAB 4)
          (PRIN1 "SPENT")
          (TAB 10)
          (PRINTAMT SPENT)
          (TAB 24)
          (PRIN1 "OWE")
          (TAB 30)
          (PRINTAMT OWE)
          (PRIN1 "       NET:")
          (PRINTAMT OWE-SPENT T)
          (FINALIST← <<NAME.ENTRIES:1 OWE-SPENT> ! FINALIST>])
)
  (RPAQQ ACCTDATVARS ((VARS FORS ACCTS NAMES STANDARDSPLIT)
          (PROP SPLIT * FORS)))
  (RPAQQ RUB ␈)
  (RPAQQ DOWNARROW ↓)
STOP