-
Notifications
You must be signed in to change notification settings - Fork 8
/
ZGL552.txt
1258 lines (1187 loc) · 26.2 KB
/
ZGL552.txt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
title 'gl552--double financial comparison print'
system
;
;
define m01:'gl552 (double financial comparison) 12/29/81'
;
; notes:
; 1/16/76...written...ns
; 1/26/76...gl10 i was reading into gdet instead of recg..ns
; 1/03/76...the level 6 of the income statement puts out l and p depending on whether the total is profit or loss.
; 3/02/76...there seems to be a problem with printing the income statement..ns
; correction in c50 - on pass for sheduled accts i wasnt going back
; to b15..ns
; 4/8/76....chng in gl30 lacct checking for le instead of eq...ns
;
; 5/6/76...correcting overflow proble in crq (top5 and line count )...ns
; 6/17/76...conversion from g930 to g530...ns
; 6/18/76...finishing conv...ns
; 6/21/76...moved call sign in subr. sttype...ns
; 6/21/76...conv. from g530 to g535...ns
; 6/24/76...changing maj so that it will not print leading zeros on branches...ns
; 7/08/76...new master file layout...ns
; 7/08/76...adding new option - comp. any two months, any two quarters..ns
; 7/09/76...master file is now 131 bytes long & has 2 headers...ns
; 8/03/76...add routine to comput year to date verance,and change layout..jp
; 8/18/76...program incorporated into standard general ledger application
; with name change, by g.l. gillette. at the
; same time, certain cosmetic changes to formats and messages,
; plus minor program modifications, were made.
; 9/16/76...f13 underline format changed, changed f240 and variance heading..ns
; 9/21/76...heading change, total levels 5 and 6 are reversed signs..ns
; 10/12/76...totals 4,5, &6 are reversed, error in tl...ns
; 3/14/77... usef now has revf as part of it, crq called before printing,
; centering headers, underline changes...ns
; 4/18/77...changing print line to 2 lines in order to fit the description..ns
; 7/20/77...changing line counter in crq to max. of 57... ns
; 7/21/78...cosmetic changes. changed f13 & f240..ns
; 10/03/78...h-accounts added...ns
; 06/20/79...changing report format..ns
; 07/16/79...changing headings (took out b.s. because options are so dif. between b.s. & inc. stmt)...ns
; 7/26/79...changed f30 to allow only 28 characters of description to print per marty's instructions..ns
; 8/06/79...sign on message..ns
; 08/29/79...line count problem on using line 61 everytime on printout..ns
;
; sw2=0 not on, 1 syas in schedule
; dont do any underlining or spacing until
; we're out of this section..
; 06/26/80...modified so i and j account's would not add into totals...kag
;
; 03/11/81...modified program to not compute % of varience if last year
; amount is zero...dl
;
; 12/29/81...recompile to have a common date base...dl
;
;
;=============================================================================
;
record recg(131)
set ?gid:0; 6 byte integer - br/maj/min 2 digits, 6 digits, 3 digits
set ff:0; f1=blank - no leading char, $= if money acct print $,
; if title account $= print $ on next money account.
; ( = enclose in parent. if neg.
; f2= # of lines of overlining. (0,1,2)
;
set vv:0; v1=type acct (title,money,total,etc.)
; v2=scheduled or not
; v3=center title or which col. a or b
; v4=total level or indicates 'c' type title
string desc(30); description
set pos:0; entered but not posted amounts
set cmo:0; current month
set mon2:0; last month
set mon3:0; 2 months ago
set mon4:0; 3 months ago
set mon5:0; 4 months ago
set mon6:0
set mon7:0
set mon8:0
set mon9:0
set mona:0
set monb:0
set monc:0
set mond:0; this month last year
set mone:0; last month last year
set monf:0; 2 months ago - last year
;
set ?cbal:0; current balance (does not include post)
set ?pbal:0; last years total prior to monf
; (ie. if cmo is 6/76 - mond=6/75, mone=5/75, mond=4/75,
; and ?pbal is total as of 3/75)
set usef:0; 0=no postings, 1=print whether postings or not, 2=postings
;
set ?mong:0; used in e account for 13th month processing & in l accounts
endrec
;
file gmst:sys0,class=2,rnd,recsiz=131,key=rel0
;
;
copy list
;
;
;
;
file crt:sysipt
file prt:syslst,class=1,seq
file control:sys2,class=2,rnd,recsiz=77,key=rel2
;
set rel2:0
;
record pnt(4)
set point:0
endrec
;
record head1(77)
string client(40)
set h0:0,a2:0,opt1:0,haflg:0,?einv:0,?binv:0
string ans(1)
endrec
;
record head2(77)
string stdate(77)
endrec
;
record head3(77)
string topcom1(64)
set ?bsea:0
define bans:'n'; this is always no in this program now
endrec
record head4(77)
string topcom2(64)
set fopt:0
set vopt:0; 1=print variance, 2=%
set acnt:0
endrec
record head5(61)
string coment(50)
set aa:0; page #ing
set dflag:0; 0=standard date, 1=column dates
endrec
record head6(48)
string to1(11),to2(11),to3(11),to4(11)
endrec
;record head7(64)
;string bs(64)
;endrec
record head8(64)
string inc(64)
endrec
record aux2(77)
set ?id:0,cur2:0,cur3:0,?curyr:0,?ltyr:0
string hdesc(30)
endrec
;
;
;
;
external ?gkey,stat,msg,ioerr,gupsi,pupsi,lfeed,cget,?edit,gjp,clrec
entrypoint crt
;
;======================
; program logic
;======================
entry
open io (crt,gmst,list,control), output prt
call gjp(0,key)
curp(crt,1,1)
curb(crt,79)
call msg(m01)
curp(crt,1,23)
;
readb(control,pnt)
call stat(1)
call adrel;rel2=1
readb(control,head1)
call stat(1)
call adrel;rel2=2
readb(control,head2)
call stat(1)
;
call adrel;rel2=3
readb(control,head3)
call stat(1)
call adrel;rel2=4
readb(control,head4)
call stat(1)
call adrel;rel2=5
readb(control,head5)
call stat(1)
call adrel;rel2=6
readb(control,head6)
call stat(1)
call adrel;rel2=7
;readb(control,head7)
;call stat(1)
call adrel;rel2=8
readb(control,head8)
call stat(1)
call bltrun(client)
call bltrun(stdate)
call bltrun(coment)
call bltrun(topcom1)
call bltrun(topcom2)
;call bltrun(bs)
call bltrun(inc)
call cent132(client,fmt1)
call cent132(stdate,fmt3)
;call cent132(bsdate,fmt3b)
;call cent132(bs,fmt2)
call cent132(inc,fmt2i)
if(a2.ne.1)go to b01
'm14'='null'
;
;
b01:
call cent132(coment,fmt6)
call cent132(topcom1,fmt4)
call cent132(topcom2,fmt5)
;
if(vopt.ne.1)go to b09; 1=amount
'm12b'='m12a'
'm18a'='null'
go to b10
b09:
'm18'='null'
b10:
call glread
if(nmin.eq.nines)go to gl85; end of report
;
if(?lid.le.?bsea)go to c60
go to c55
b20:; titled account
call bltrun(desc)
call cent132(desc,f240)
go to (b22,b21)on l4
call crq
go to b23
b21:
topflg=1
lsw=0
call top
topflg=0
go to b10
b22:
call top
b23:
if(l3.eq.2)go to b25
;if(?gid.le.?bsea)go to b24
write(prt,fmt2a)desc; no centering
go to b10
;b24:
;write(prt,f03)desc
;go to b10
b25:
write(prt,f240)desc; centered
go to b10
b28:
b30:; l1=1 - d acct (precedes scheduled accounts
?sgid=?gid
nrel=rel0; saves this till later
sl2=l2
savrel2=rel2
;
go to b10
;
b40:; money accounts
call typest; write account
go to b10
;
;=================
;================== sheduled accounts=====================
;
;
c10:
call ?clr(?b6,?curamo,?b7,?b8,0)
a3=1; this is a flag that indicates that there are scheduled accounts
;
c15:
sw2=1
if(sl2.eq.4)go to c16; dont print the d account
if(l1.eq.5)go to c16
if(l1.ne.2)go to c15f
if(l4.ge.7)goto c16; i account
c15f:
call ?acu(?curamo,?cmo,?b6,?tamt,?b7,?cubal,?b8,?ltbal,0)
c16:
call glread
if(nmin.eq.nines)go to gl85
if(l2.eq.2)go to c15
?lid=?gid
fa1=rel0
rel0=nrel
if(sl2.eq.4)go to c26; dont print d account
'desc'='null'
if(rel0.eq.0)goto c25; have been no d accounts so far
readb(gmst,recg)
call stat(1)
call dvv
if(l1.le.3)go to c22
nn=rel2
rel2=savrel2
readb(control,aux2)
call stat(1)
rel2=nn
'desc'='hdesc'
;
c22:
;
call gl60
;
c25:
;
?tamt=?b6
?cmo=?curamo; current month, ?tamt is last year month
?cubal=?b7; current yr
?ltbal=?b8; last year
call typest
c26:
;
rel0=fa1; saved in c16
readb(gmst,recg)
call stat(1)
sw2=0
if(l1.le.3)go to c30
; even inv. is in aux on double comp.
rel2=nn
readb(control,aux2)
call stat(1)
c30:
call gl60; entry point in glread
go to c60
;
;
c55:
goto (c60)on a4
lsw=0
call ?clr(?x1,?x2,?x3,?x4,?x5,?x6,?x7,?c1,?c2,?c3,?c4,?c5,?c6,?c7,0)
a4=1
if(l1.ne.0)go to c56
if(l4.ge.1)go to c60
c56:
call top
line=line-1; this is the only place that there is no line printed after calling crq
;
c60:
goto (c70)on pass
if(l2.eq.2)go to c10; sheduled account
c70:
if(l1.eq.0)go to b20; titled account
go to (b30,b40,d15,b40,b40,b40)on l1
d15:
;
;
;
d20:; determine total level
fa1=l4-1
call tget(?tx,fa1,?x1,6)
call tget(?ty,fa1,?y1,6)
call tget(?ttx,fa1,?c1,6)
call tget(?tty,fa1,?b1,6)
call tl
go to (d26,d31,d36,d41,d45,d41)on fa1
;
d24:
call ?clr(?x1,?y1,?c1,?b1,0)
go to b10
;
d26:
call ?clr(?x2,?y2,?c2,?b2,0)
go to d24
;
d31:
call ?clr(?x3,?y3,?c3,?b3,0)
go to d26
;
d36:
call ?clr(?x4,?y4,?c4,?b4,0)
go to d31
;
d41:
call ?clr(?x5,?y5,?c5,?b5,0)
go to d36
d45:
;
call ?clr(?x6,?y6,?c6,?b11,?x7,?y7,?c7,?b12,0)
dfl=0; restart baseline on total level 6
go to d41
;
;
;=============================================================================
;=============== s u b r o u t i n e s =======================================
;=============================================================================
; subroutine directory
; glread - reads g/l master file
; typest- prints details for balance sheet
; sttype- prints details for comparative statement
; tl - total lines for comparative statement
; ckamt - determines which month is current for finan. statement
; crq - increases line counter
; (top)- part of crq (top of form and heads it)
; sign - checks to see if sign should be reversed and edits
; into num1.
;============================================================================p
;
;===============
subroutine adrel
;===============
rel2=rel2+1
return
;
;=========================
subroutine bltrun
;=========================
;
; to truncate trailing blanks from a character string
;
; calling sequence:
;
; call bltrun (string)
;
direct
lda- x+ get string address
xay
cla clear string char count
sta= *-* save it for later
@p1 set *-2
@p2 set *
ina increment char count
ldbb- y+ check for terminator
bnz @p2 loop if not terminator
ldbb- y- back up past terminator
dca adjust char count
@p3 set *
sta @p1 save char count
ldbb- y- get suspect char
ldab= c' ' check for trailing blank
sabb
bnz *+9 skip exit if non-blank
cla else move term
stab- y
lda @p1 check char count
dca
bnz @p3 loop if more to check
@p4 set *
cpl
return
;=========================
subroutine cent132
;=========================
;
; to cause a format statement to be set for printing a character
; string centered on a 132-column line.
;
; calling sequence:
;
; call bltrun (string); truncate trailing blanks in the string
; call cent132 (string, fmtx); set the format
; write (prt, fmtx) string; write the centered string
;
; where: format fmtx: x100, c100; values of x & c are arbitrary
;
direct
lda- x+ get address of string
xay save string address
cla clear character count
dca preset to count characters
@p1 set *
ina incr char count
ldbb- y+ get char from string
bnz @p1 loop if not terminator
ldb- x+ get address of format statement
inr b incr to address of x-specification
xfr b,y save x-spec address for later
inr b,3 incr to address of c-specification
sta- b set new char count in c-spec of format statement
ldb= 132 get standard page width
sub b,a subtract chars in this string
sra divide result by 2 for leading spaces
sta- y set new space count in x-spec of format statement
cpl
return
;
subroutine tget
;=================
direct
lda- x+ get target address
sta tga
lda- x+ get index
ina ,2
lda- a
xay save it for later
ldb- x+ get table start
lda- x+ get table unit byte length
stx- s-
sta- s-
tg01 add y,b mpy index*unit-byte-length
dca
bnz tg01
ldx= *-*
tga equ *-2
lda- s+
xay maove xfr count to y
tg02 ldab- b+
stab- x+
dcr y decr xfr count to y
bnz tg02
ldx- s+
cpl
return
;
;
;=========================
subroutine glread
;========================
gl30:; read from master file drive = 2
readb(list,listb)
goto (gl70)on status
if(?lid.le.100)go to gl30; headers
ifs(bans.eq.yes)go to gl30c
if(?lid.le.?bsea)go to gl30; dont want these guys
gl30c:
readb(gmst,recg)
call stat(1)
if(?gid.le.0)go to gl30; deleted accounts
call dvv
if(l4.ne.6)go to gl30d
if(l1.ne.3)go to gl30d
flg6=flg6+1
gl30d:
if(l4.eq.8)go to gl30; not printed
if(l1.lt.4)go to gl30f; not a calc account
call rdaux; even inventory is in this file for double comp.
gl30f:
;
;if(?lid.le.?bsea)go to gl60
go to (gl35,gl60)on dfl
;
gl31:
note(list,point2); save pointer
dfl=1; first income account
call ?clr(?inytd,?incur,?incubal,?inltbal,0)
;
'lbrn'='brn'
gl35:
call dacct
ifs(lbrn.ne.brn)go to gl40; no total level 2 in branch
call ckamt; figures which months amount we are working with
if(l1.eq.5)go to gl37; j account don't add
if(l1.ne.2)go to gl36
if(l4.ge.7)go to gl37
gl36:
call ?acu(?inytd,?tamt,?incur,?cmo,?incubal,?cubal,?inltbal,?ltbal,0)
gl37:
if(l1.ne.3)go to gl30; not to end of income
if(l2.eq.2)go to gl30; scheduled
if(l4.lt.2)go to gl30; not to end of income
;
gl40:
if(aa.ne.1)go to gl41
page=0
gl41:
?inytd=0-?inytd; reverse the sign (income is normally a credit amount)
?incur=0-?incur; reverse the sign of the income
?incubal=0-?incubal
?inltbal=0-?inltbal
dfl=2; beyond income accts in income statement
point(list,point2)
go to glread
;
;
gl50:; reading work3 - scheduled info
if(l1.ne.1)go to gl52;not d account
ssw=l2
gl52:
if(l2.ne.2)go to gl30
if(ssw.eq.3)go to gl30
go to gl65
gl60:
call dacct
call ckamt
call dvv
gl62:
;
go to (gl65)on sw2
;
; (note pass cant be 1 if sw2 is =1
;
ifs(brn.ne.lbrn)go to gl31
;
'lbrn'='brn'
goto (gl50)on pass
;
;
gl65:
go to (gl69p)on sw2
'acct'='zer3'
encode(acct,fn3)ff; f1=$ or not
decode(acct,f10)f0,f1,f2; f2=lines of underlining
gl66:
xx=f2/2*2
if(f2.eq.0)go to gl69
call addline
if(xx.ne.f2)go to gl67; f2 is 1,3,5,or 7
'mss'='m17'
go to gl67g
;
gl67:
'mss'='m19'
;
gl67g:; this only deals with income statement format
;if(?gid.le.?bsea)go to gl68
write(prt,f13)mss,mss,mss,mss; income
go to gl69f
;gl68:
;write(prt,f13b)mss,mss
gl69:
go to gl69f;if(?gid.gt.?bsea)go to gl69f
;revf=0
;if(flg6.ne.1)go to gl69g
;revf=1
;goto gl69g
gl69f:
if(l1.eq.6)go to gl69ff
if(l1.ge.4)go to gl69q
gl69ff:
revf=usef/10
gl69g:
usef=usef-(usef/10*10)
gl69p:
return
gl69q:
revf=f0
usef=0
return
;
;
gl70:; finished with master now go back and list scheduled info
go to (gl40)on dfl
pass=pass+1
if(pass.gt.1)go to gl85; pass=0, reg.; pass=1 scheduled, pass=2 finished
if(a3.eq.0)go to gl85; there was no scheduled info
a3=dfl=a4=?gid=flg6=0; a3 indicates schedules, dfl indicates whether income for % has been totaled
if(aa.ne.1)go to gl75
page=0
gl75:
; a4=indicates income statment
rewind list
go to gl30
;
gl85:
line=60-line
if(line.le.0)go to gl90
call lfeed(prt,line)
gl90:
write(prt,fmt6)coment
load(xgl553,0,0)
stop 50
;
;=====================
subroutine dvv
;======================
;
'acct'='zer4'
encode(acct,f04)vv
decode(acct,f10)l1,l2,l3,l4
return
;
;==================
subroutine dacct
;==================
'acct'='zer12'
encode(acct,f07)?gid
decode(acct,f08)brn
return
;=======================
subroutine rdaux
;=======================
;
if(?gid.gt.?id)go to rda10
;
rel2=8; restart it - may be rewind on scheduled
;
rda10:
;
call adrel;rel2=rel2+1
if(rel2.gt.point)go to rda20; not here for some reason
readb(control,aux2)
call stat(1)
if(?gid.ne.?id)go to rda10
;have it
;
;
return
rda20:
call clrec(aux2)
return; not foun
;
;
;
;
;=====================
subroutine typest ; writes money details for balance sheet
;=====================
;
ifstring(ans.eq.yes)go to ty10; print all
if(?tamt.ne.0)go to ty10; may be a d acct from scheduled
if(?cmo.ne.0)go to ty10
if(?ltbal.ne.0)go to ty10
if(?cubal.ne.0)go to ty10
if(usef.ne.1)go to ty50; no activity (may be no activity but print anyway
if(l1.gt.3)go to ty50; j/k/l only print if has balances
;
ty10:
go to sttype
ty50:
return
;
;=======================
subroutine percent
;=======================
direct
lda- x+
sta pt10+3
lda- x+
sta pt12+3
lda- x+
sta pt20+28
cpl
;
pt10:
?zero1=?zero1
pt12:
?zero2=?zero2
go to pt30
;
pt20:
pcytd=?zero1*hthou/?zero2+fiv/10
;
return
;
pt30:
if(?zero1.lt.0)go to pt35
;
if(?zero2.lt.0)go to pt40
; same sign
pt32:
fiv=5
goto pt20
;
pt35:
if(?zero2.lt.0)go to pt32; same sign
;
pt40:
;opposite signs
fiv=-5
goto pt20
;
;
;==================
subroutine sttype; writes detail lines in income statement section
;==================
;
;
;
call sign(?tamt)
'nnum2'='num1'
call sign(?cmo)
'num2'='num1'
go to (ty59)on a2
call percent(?tamt,?inytd,pcytd)
call percent(?cmo,?incur,pccur)
ty59:
call sign(?ltbal)
'nnum'='num1'
call sign(?cubal)
'nnum1'='num1'
go to (ty70)on a2
call percent(?ltbal,?inltbal,dtpcytd)
ty59a:
call percent(?cubal,?incubal,dtpccur)
;
ty70:
?var=?cubal-?ltbal
;
if(?ltbal.eq.0)goto ty75; don't compute % of variance if last yr=0
call percent(?var,?ltbal,pcvar)
;
ty75:
call sign(?var)
;
call printit
;
if(l1.eq.5) goto ty130; j acct not added...6/26/80..kag
if(l1.ne.2) goto ty121
if(l4.ge.7) goto ty130; i account are not added into total...6/26/80..kag
;
ty121:
call ?acu(?x1,?tamt,?x2,?tamt,?x3,?tamt,?x4,?tamt,?x5,?tamt,?x6,?tamt,?x7,?tamt,0)
call ?acu(?y1,?cmo,?y2,?cmo,?y3,?cmo,?y4,?cmo,?y5,?cmo,?y6,?cmo,?y7,?cmo,0)
call ?acu(?c1,?ltbal,?c2,?ltbal,?c3,?ltbal,?c4,?ltbal,?c5,?ltbal,?c6,?ltbal,?c7,?ltbal,0)
call ?acu(?b1,?cubal,?b2,?cubal,?b3,?cubal,?b4,?cubal,?b5,?cubal,?b11,?cubal,?b12,?cubal,0)
;
ty130:
return
;
;=====================
subroutine tl; total line for comparative statement
;=====================
;
call percent(?tx,?inytd,pcytd)
call percent(?ty,?incur,pccur)
call sign(?ty)
'num2'='num1'
call sign(?tx)
'nnum2'='num1'
call percent(?ttx,?inltbal,dtpcytd)
call percent(?tty,?incubal,dtpccur)
call sign(?tty)
'nnum1'='num1'
callsign(?ttx)
'nnum'='num1'
?var=?tty-?ttx
call percent(?var,?ttx,pcvar)
call sign(?var)
call printit
tl50:
return
;
;=====================
subroutine printit
;=====================
call edpc
call crq
;if(?gid.le.?bsea)go to pr07
go to (pr02)on vopt
'num1'='pnum5'; printing %
pr02:
go to (pr10)on a2; no percents
pr03:
go to (pr05)on fopt
write(prt,f30)desc,num2+1,pnum1+1,nnum1+1,pnum3+1,nnum2+1,pnum2+1,nnum+1,pnum4+1,num1+2
return
pr05:
write(prt,f30)desc,num2+1,pnum1+1,nnum2+1,pnum2+1,nnum1+1,pnum3+1,nnum+1,pnum4+1,num1+2
;
return
;pr07:
;go to(pr08)on vopt
;'num1'='spc10'
;go to pr09
;pr08:
;'pnum5'='spc10'
;pr09:
;write(prt,f30b)desc,nnum1+1,nnum+1,num1+1,pnum5+8
;return
pr10:
'pnum1'='spc10'
'pnum2'='spc10'
'pnum3'='spc10'
'pnum4'='spc10'
go to pr03
;====================
subroutine ?acu
;====================
direct
lda- x+
bnz *+3
rsr
sta ac10+3 ac10+13=ac10+3 + ac10+8
sta ac10+13
lda- x+
sta ac10+8
cpl
;
ac10:
?x1=?x1+?cmo
goto ?acu
;
;========================
;=========================
;
subroutine ckamt; determines what months values are to be used
;=====================
;
if(l1.gt.3)go to ck20; calculation account
; this is the main difference bet. g530 and g535
;
go to (ck10)on opt1;0=compare months, 1=compare qtrs
ck05:
?cmo=cmo
?tamt=mond
call tot
return
;
ck10:
?cmo=cmo+mon2+mon3 ; this quarter
?tamt=mond+mone+monf; this quarter last year
call tot
return
;
ck20:
;
?cmo=cur2
?tamt=cur3
?cubal=?curyr
?ltbal=?ltyr
return
;
;========================
subroutine tot
;========================
;
?cubal=?cbal
?ltbal=?pbal+mond+mone+monf
;
return
;========================
subroutine crq
;========================
if(line.ge.99)go to top7
if(line.ge.58)go to top
call addline
lsw=0; at lease 1 line has been written since the header
return
top:
if(line.ge.99)go to top7
go to (top72)on lsw; nothing has been written so dont top of form again
line=60-line
if(line.le.0)go to top5
call lfeed(prt,line)
top5:
write(prt,fmt6)coment
top7:
write(prt,fmt2a)eject
write(prt,fmt1)client
'ms1'='spc10'
if(aa.eq.2)go to top11
page=page+1
encode(ms1,f110)m20,page
top11:
'headline'='spc10+spc10+spc10+spc10+spc10+spc10+spc10+spc10+spc10+spc10'
;if(?gid.le.?bsea)go to top11f
encode(headline,fmt2i)inc
write(prt,fmt2a)headline,ms1
go to top12
;top11f:
;encode(headline,fmt2)bs
;write(prt,fmt2a)headline,ms1
;write(prt,fmt3b)bsdate