10 REM:  PROGRAM NAME "EXP245"
20 REM- PROGRAM UPDATES EMPLOYEE SALARY REC AND GENERATES
   PAYROLL TRANS FO SALRIED EMPLOYEES ONLY
22 !
23 !   PROGRAM SET UP FOR 1974 FICA DEDUCTIONS
24 !      5.85% OF GROSS UP TO $13,200.          1/4/74
25 !
30 OPEN "DF:TRANS.PAY" AS FILE 5
40 DIM #5,T$(2000)=46
50 OPEN "LP:" FOR OUTPUT AS FILE 2
60 OPEN "DF:EMPLOY.MST" AS FILE 1
65 DIM #1,E$(500)=255
66 INPUT "IS THIS A SALARY OR AN HOURLY PAYROLL" X$
67 IF X$="HOURLY" GOTO 75
68 IF X$="SALARY" GOTO 80
69 GOTO 66
75 LET X5$="2"
76 GOTO 95
80 LET X5$="1"
95 LET X=1
100 LET X%=X%+1
110 LET B$=E$(X%)
150 IF LEFT(B$,5)="99999" GOTO 3000
155 IF X5$="2" AND MID(B$,29,1)="1" GOTO 180
156 IF X5$="1" AND MID(B$,29,2)="01" GOTO 180
157 GOTO 100
180 LET L1$=MID(B$,45,6)
185 IF L1$="      " GOTO 100
186 IF VAL(L1$)=0 GOTO 100
190 LET L2$=MID(B$,51,5)       !FED TAX
200 LET L3$=MID(B$,56,5)       !STATE TAX
210 LET L4$=MID(B$,61,5)       !FICA
220 REM- NEXT ARE VOLUNTARY DEDUCTIONS
230 LET M1$=MID(B$,66,5)       !HOSPITAL BLDG FUND
240 LET M2$=MID(B$,71,5)       !ANNUITY
250 LET M3$=MID(B$,76,5)       !CREDIT UNION
260 LET M4$=MID(B$,81,5)       !RETIREMENT
270 LET M5$=MID(B$,86,5)       !WASH NATIONAL
280 LET M6$=MID(B$,91,5)       !BC/BS
290 LET M7$=MID(B$,96,5)       !MISC
300 REM-NEXT ARE YTD EARNINGS AND DEDUCTIONS
310 LET N1$=MID(B$,101,7)      !YTD GROSS PAY
320 LET N2$=MID(B$,108,7)      !CONTRACT TO DATE
330 LET N3$=MID(B$,115,6)   !YTD FED TAX
340 LET N4$=MID(B$,121,6)      !YTD STATE TAX
350 LET N5$=MID(B$,127,6)      !YTD FICA
360 REM-NEXT ARE YTD VOLUNTARY DEDUCTIONS
370 LET O1$=MID(B$,133,6)      !HOSP BLDG FUND
380 LET O2$=MID(B$,139,6)
390 LET O3$=MID(B$,145,6)      !CREDIT UNION
400 LET O4$=MID(B$,151,6)      !RETIREMENT
410 LET O5$=MID(B$,157,6)    !WASH NATNL
420 LET O6$=MID(B$,163,6)      !BC/BS
430 LET O7$=MID(B$,169,6)      !MISC
440 REM - PAYROLL ACCOUNTS NEXT
450 LET R1$=MID(B$,180,7)        !MAIN ACCOUNT NUMBER
460 LET R2$=MID(B$,187,7)        !MAIN GROSS ACCOUNT
470 LET R3$=MID(B$,194,5)        !PAY PERIOD AMT
480 LET S1$=MID(B$,199,7)        !AUX ACCT NUMBER
485 LET S3$=MID(B$,213,5)
490 LET T1$=MID(B$,218,7)        !AUX ACCOUNT NUMBER
495 LET T3$=MID(B$,232,5)
500 REM- GENERATES PAYROLL TRANS RECORD
501 LET S=0
502 LET T5$=SPACE$(4)+"3"+SPACE$(24)
505 IF X5$="2" GOTO 540     !NO PAY TRANS IF HOURLY
510 IF R1$=SPACE$(7) GOTO 550
520 LET T$(X)=R1$+T5$+R3$+SPACE$(5)
530 LET X=X+1
540 LET S=S+VAL(R3$)
550 IF S1$=SPACE$(7) GOTO 600
565 IF X5$="2" GOTO 590  !NO PAY TRANS FOR HOURLY
570 LET T$(X)=S1$+T5$+S3$+SPACE$(5)
580 LET X=X+1
590 LET S=S+VAL(S3$)
600 IF T1$=SPACE$(7) GOTO 650
615 IF X5$="2" GOTO 640     !NO PAY TRANS FOR HOURLY
620 LET T$(X)=T1$+T5$+T3$+SPACE$(5)
630 LET X=X+1
640 LET S=S+VAL(T3$)
650 LET N1=VAL(N1$)
660 LET N1=N1+VAL(L1$)
670 LET X9$=FNK$(N1)
680 LET A1=7
690 GOSUB 2000
700 LET N1$=SPACE$(M)+X1$     !UPDATE YTD GROSS
702 LET N2=VAL(N2$)+VAL(L1$)
703 LET X9$=FNK$(N2)
704 LET A1=7
705 GOSUB 2000
706 LET N2$=SPACE$(M)+X1$    !UPDATE QUARTERLY FOR FICA
710 LET L2=VAL(L2$)           !FED TAX
720 LET N3=VAL(N3$)           !YTD FED TAX
730 LET N3=N3+L2
740 LET A1=6
750 LET X9$=NUM$(N3)
760 GOSUB 2000
770 LET N3$=SPACE$(M)+X1$     !UPDATE YTD FED TAX
780 LET N4=VAL(N4$)           !YTD STATE TAX
790 LET L3=VAL(L3$)
800 LET N4=N4+L3              
810 LET A1=6
820 LET X9$=NUM$(N4)
830 GOSUB 2000
840 LET N4$=SPACE$(M)+X1$         !UPDATE YTD STATE TAX
845 IF L4$="00000" GOTO 913
850 LET N5=VAL(N5$)               !YTD FICA
860 LET L4=VAL(L4$)
870 LET N5=N5+L4
872 IF N5>(5.85*13200) THEN GOTO 1800
890 LET X9$=NUM$(N5)
891 LET A1=6
900 GOSUB 2000
910 LET N5$=SPACE$(M)+X1$         !UPDATE YTD FICA
913 REM-NEXT ARE VOLUNTARY DEDUCTIONS
914 IF X5$="2" AND MID(B$,30,1)="1" GO TO 1362
915 IF M1$="00000" OR M1$="     " GOTO 960
920 LET O1=VAL(O1$)+VAL(M1$)    !UPDATE YTD HOSP BLDG DEDUCT
929 LET X9$=NUM$(O1)
930 LET A1=6
940 GOSUB 2000
950 LET O1$=SPACE$(M)+X1$
960 IF M2$=SPACE$(5) OR M2$="     " GOTO 1000
965 LET O2=VAL(O2$)+VAL(M2$)
975 LET X9$=NUM$(O2)
978 LET A1=6
980 GOSUB 2000
990 LET O2$=SPACE$(M)+X1$
1000 IF M3$="00000" OR M3$="     " GOTO 1080
1010 LET O3=VAL(O3$)+VAL(M3$)   !UPDATE YTD CREDIT UNION
1015 LET X9$=NUM$(O3)
1060 GOSUB 2000
1070 LET O3$=SPACE$(M)+X1$
1080 IF M4$="00000" OR M4$="     " GOTO 1150
1090 LET O4=VAL(O4$)+VAL(M4$)  !UPDATE YTD RETIRMNT
1120 LET X9$=NUM$(O4)
1130 GOSUB 2000
1140 LET O4$=SPACE$(M)+X1$
1150 IF M5$="00000" OR M5$="     " GOTO 1220
1160 LET M5=VAL(M5$)+VAL(O5$)
1165 LET X9$=NUM$(M5)
1200 GOSUB 2000
1210 LET O5$=SPACE$(M)+X1$
1220 IF M6$="00000" OR M6$="     " GOTO 1290
1230 LET O6=VAL(O6$)+VAL(M6$) !UPDATE YTD BC/BS
1250 LET X9$=NUM$(O6)
1270 GOSUB 2000
1280 LET O6$=SPACE$(M)+X1$
1290 IF M7$="00000" OR M7$="     " GOTO 1362
1300 LET O7=VAL(O7$)+VAL(M7$)   !UPDATE YTD MISC DEDUCT
1330 LET X9$=NUM$(O7)
1350 GOSUB 2000
1360 LET O7$=SPACE$(M)+X1$
1362 LET T2$=MID(B$,225,7): LET S2$=MID(B$,206,7)
1363 LET L0$=L1$+L2$+L3$+L4$
1364 LET M0$=M1$+M2$+M3$+M4$+M5$+M6$+M7$
1365 LET N0$=N1$+N2$+N3$+N4$+N5$
1366 LET O0$=O1$+O2$+O3$+O4$+O5$+O6$+O7$
1367 LET R$=R1$+R2$+R3$
1368 LET S$=S1$+S2$+S3$
1369 LET T0$=T1$+T2$+T3$
1370 LET U$=MID(B$,237,19)
1373 LET P$=MID(B$,175,5)
1375 LET E$(X%)=LEFT(B$,28)+"1"+MID(B$,30,15)+L0$+M0$+
     N0$+O0$+P$+R$+S$+T0$+U$
1720 GOTO 100
1800 LET N5=N5-L4
1802 IF N5>=77220 GOTO 1860
1805 LET L4=(5.85*13200)-N5
1810 LET A1=5
1820 LET X9$=NUM$(L4)
1830 GOSUB 2000
1840 LET L4$=SPACE$(M)+X1$
1850 GOTO 870
1860 LET L4$="00000"
1870 GOTO 915
2000 REM-SUBROUTINE TO FORMAT RESULTS OF NUM$
2010 LET A=LEN(X9$)
2012 LET N=1
2015 LET A=A-1
2016 IF A>A1 GOTO 2050
2020 LET X1$=MID(X9$,N,A)
2030 LET M=A1-A
2040 RETURN
2050 IF LEFT(X9$,N)<>" " THEN STOP
2060 LET N=N+1
2080 GOTO 2015
3000 IF X5$="2" GOTO 3010
3005 LET T$(X)="9999999"+SPACE$(34)+"99999"
3010 CLOSE 1,2,5
3011 IF X5$="1" GO TO 4120
3012 CHAIN "EXP277"
4000 ! REPLACEMENT FOR RSTS V03C NUM$ FUNCTION FOR 7-DIGIT NUMBERS
4010 DEF FNK$(K)
4020 LET K1=INT(K/100)
4030 LET K2=K-(K1*100)
4040 LET K1$=NUM$(K1)
4050 LET K2$=NUM$(K2)
4060 LET K3=LEN(K1$)
4070 LET K4=LEN(K2$)
4080 IF K2>9 GO TO 4110
4090 LET K2$=" 0"+MID(K2$,2,K4-1)
4100 LET K4=K4+1
4110 LET FNK$=LEFT(K1$,K3-1)+RIGHT(K2$,2)
4115 FNEND
4120 END