-
Notifications
You must be signed in to change notification settings - Fork 0
/
STACK.EXT.COMM
1297 lines (1297 loc) · 51.4 KB
/
STACK.EXT.COMM
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
$BASICTYPE "P"
SUBROUTINE STACK.EXT.COMM(ANS)
*******************************************************************************
* INFOLEASE UTILITIES
*******************************************************************************
MAIN:
EQUATE NUL TO '', SPC TO ' ', TRUE TO 1, FALSE TO 0
GOSUB INIT
COMMANDS='AF,BPI,CCI,CCM,CI,CM,CT,DESC,FIELD,FIND.MENU,SQL-LIST,LISTA,MODULES,NED,NSEL,PARAM,RS,SE,SQL,SQLF,TM,XREF'
CONVERT ',' TO @VM IN COMMANDS
FIRST.WORD=FIELD(ANS,' ',1)
LOCATE FIRST.WORD IN COMMANDS<1> SETTING INTERNAL.COMMAND ELSE
PRINT 'Invalid command' ; RETURN
END
ON INTERNAL.COMMAND GOSUB ATB.FIND, BPI, CCI, CCM, CI, CM, VIEW.RECORD, IL10.DESC, IL10.FIELD, FIND.MENU, SQL.SEL.LIST, LISTA,
LIST.MODULES, IL10.NED, IL10.NSEL, LIST.PARAM, RS, SEARCH.EXAMPLE, SQL.SEL, SQL.FILE,
TM, IL10.XREF
RETURN
*
REMOVE.CONTROL.CHARS:
* Remove control characters from ANS, useful for pasting from excel
ANS=OCONV(ANS,'MCP')
CONVERT '~' TO '' IN ANS
RETURN
*
EXEC.SUB:
* Execute a command, capturing the output if necessary
IF EXEC.LINE = NUL THEN RETURN
IF EXEC.LINE = 'CLEARSELECT' THEN CLEARSELECT ; RETURN
IF CAP.ACTIVE THEN
EXECUTE EXEC.LINE CAPTURING EXEC.CAP
END ELSE
EXECUTE EXEC.LINE
END
IF SYSTEM(11) > 0 THEN SL.ACTIVE = TRUE ELSE SL.ACTIVE = FALSE
CAP.ACTIVE=FALSE
RETURN
*
INIT:
OPEN 'VOC' TO VOC ELSE STOP 201,'VOC'
OPEN '_HOLD_' TO F.HOLD ELSE STOP 201,'_HOLD_'
SHOW.SELECT=0
TERM.WIDTH=132
DIM RECORD.DATA(10)
* IL9/IL10 Check
IL.DB=''
IL.VER=''
IL.MAJOR.VER=''
REV.ATB.LOG=''
OPEN 'ACCOUNT.PARAMS' TO ACCOUNT.PARAMS THEN
READ VERSION FROM ACCOUNT.PARAMS, 'VERSION' ELSE VERSION=''
IL.DB=@ACCOUNT
IL.VER=VERSION<4>:'/':VERSION<8>:'.':VERSION<26>
IL.MAJOR.VER=9
OPEN 'REV.ATB.LOG' TO REV.ATB.LOG ELSE STOP 201,'REV.ATB.LOG'
DB='UD'
END ELSE
OSREAD JDBC FROM 'DBConfig.xml' THEN
CONVERT CHAR(13) TO '' IN JDBC
CONVERT CHAR(10) TO @AM IN JDBC
JDBC=JDBC<2> ;* <DataSource>InfoLease</DataSource>
JDBC=FIELD(JDBC,'>', 2)
JDBC=FIELD(JDBC,'<', 1)
IF JDBC # '' THEN
OSREAD JDBC.P FROM '../../jdbc-bridge/bin/jdbc.properties' THEN
CONVERT CHAR(13) TO '' IN JDBC.P
CONVERT CHAR(10) TO @AM IN JDBC.P
FOR F=1 TO DCOUNT(JDBC.P,@AM)
L=JDBC.P<F>
IF JDBC=FIELD(L,'.',1) AND INDEX(L,'url',1) THEN IL.DB=L ; EXIT
NEXT F
END
END
END
IF INDEX(UPCASE(IL.DB),'ORACLE',1) THEN DB='ORA' ELSE DB='MSSQL'
OSREAD VER FROM 'version.properties' ELSE VER='il.version=10'
CONVERT CHAR(13) TO '' IN VER
CONVERT CHAR(10) TO @AM IN VER
FOR F=1 TO DCOUNT(VER,@AM)
IF FIELD(VER<F>,'=',2) # '' THEN IL.VER=FIELD(VER<F>,'=',2) ; EXIT
NEXT F
IL.MAJOR.VER=10
END
RETURN
IL10.NED:
* Simulate the ED command with a record read from SQL server
IF IL.MAJOR.VER=9 THEN PRINT 'Only works in IL10' ; RETURN
FILE.NAME=FIELD(ANS,' ',2)
K.FILE=FIELD(ANS,' ',3)
CALL FILE.OPEN.OK(FILE.NAME, F.FILE, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Cannot open ':FILE.NAME ; RETURN
CALL IDS.READ(R.FILE, F.FILE, K.FILE, 0, 0, BCI.ERROR)
IF BCI.ERROR # '' THEN PRINT BCI.ERROR ; R.FILE=''
R.ORIG=R.FILE
*
LOOP
PRINT DCOUNT(R.FILE,@AM):' fields in record'
PRINT 'Enter D)elete, E)dit, L)ist, S)ave or Q)uit:':
INPUT OPT
BEGIN CASE
CASE OPT='D'
CRT 'Are you *really* sure (YES/N):':
INPUT YORN
IF YORN = 'YES' THEN
CALL IDS.DELETE(F.FILE, K.FILE, 0, 0)
CRT FILE.NAME:' ':K.FILE:' deleted'
LOG='NED/DELETE'
LOG<2>=FILE.NAME
LOG<3>=K.FILE
R.FILE=''
RETURN
END
CASE OPT='L'
R.TMP=R.FILE ;* In case we've edited, VIEW.RECORD will read it in again
GOSUB VIEW.RECORD
R.FILE=R.TMP
CASE OPT='S'
CALL IDS.WRITE(R.FILE, F.FILE, K.FILE, 0, 0)
PRINT 'Saved. Press ENTER to continue:':
LOG='NED/SAVE'
LOG<2>=FILE.NAME
LOG<3>=K.FILE
R.ORIG=R.FILE
INPUT AAA
CASE OPT='E'
R=R.FILE
SWAP CHAR(13):CHAR(10) WITH '||' IN R
TMP.FILE=K.FILE
CONVERT '*' TO '#' IN TMP.FILE
WRITE R ON F.HOLD, TMP.FILE
EXECUTE \ED _HOLD_ \:TMP.FILE
READ R FROM F.HOLD, TMP.FILE ELSE R=''
SWAP '||' WITH CHAR(13):CHAR(10) IN R
IF R # R.FILE THEN
PRINT 'Record changed, use S to save'
R.FILE=R
END
DELETE F.HOLD, TMP.FILE
CASE OPT='Q'
IF R.FILE#R.ORIG THEN
PRINT 'Record changed, are you sure (Y/N):':
INPUT YORN
IF YORN # 'Y' THEN OPT=''
END
END CASE
UNTIL OPT='Q' DO
REPEAT
RETURN
*
GET.BPI:
* Given a BPI name, get the BPI record
BPI.REC=''
BPI.R=''
OPEN 'DATABASE.FILES,IL' TO IL ELSE CRT 'Cannot open DATABASE.FILES,IL' ; RETURN
OPEN 'IL.BPI' TO IL.BPI ELSE CRT 'Cannot open IL.BPI' ; RETURN
* Param 2 can be a BPI or a FILENAME
READ BPI.R FROM IL.BPI, BPI ELSE
READV IL.MSG FROM IL, BPI, 14 THEN
* Sample: Attached to FLOAT.INCOME bpi.
N=DCOUNT(IL.MSG,' ')
BPI=FIELD(IL.MSG,' ',N-1)
READ BPI.R FROM IL.BPI, BPI ELSE PRINT 'Cannot get BPI name' ; RETURN
END ELSE
PRINT 'Cannot read DATABASE.FILES,IL',BPI ; RETURN
END
END
*
FOR F=1 TO DCOUNT(BPI.R,@AM)
L=BPI.R<F>
IF L[1,6] = 'EQUATE' THEN
FLD.NUM=FIELD(FIELD(L,'(',2),')',1)
BPI.REC<FLD.NUM>=FIELD(BPI.R<F>[8,99],' ',1)
END
NEXT F
*
CLOSE IL
CLOSE IL.BPI
RETURN
*
BPI:
* Edit a BPI record
BPI=FIELD(ANS,' ',2)
IF BPI='' THEN PRINT 'Usage: BPI <name of infolease file|name of BPI>' ; RETURN
GOSUB GET.BPI
IF BPI.REC='' THEN RETURN
EXEC.LINE=\AE IL.BPI \:BPI
GOSUB EXEC.SUB
RETURN
*
GET.FILE.METADATA:
* Given FILE.NAME, get column names and types in FILE.META
TMP.FILE.NAME=FILE.NAME
FILE.META='' ; BPI='' ; TABLE.NAME=''
IF FILE.NAME='PARAMETER' THEN
* Need to figure out based on record key, not just FILE.NAME
GOSUB GET.PARAMETER.BPI
IF BPI = '' THEN RETURN
IF IL.MAJOR.VER=9 THEN FILE.NAME=BPI ELSE FILE.NAME=TABLE.NAME
END
*
IF IL.MAJOR.VER=9 THEN
GOSUB GET.FILE.METADATA.IL9
END ELSE
GOSUB GET.FILE.METADATA.IL10
END
FILE.NAME=TMP.FILE.NAME
CRT 'BPI=':BPI:', TABLE NAME=':TABLE.NAME
RETURN
*
GET.PARAMETER.BPI:
* Figure out the BPI for a PARAMETER record, based on the key structure
TMP.ANS=ANS
ANS='/NOLIST' ;* Signal LIST.PARAM to just build the P array, don't list anything
GOSUB LIST.PARAM
ANS=TMP.ANS
*
BPI=''
FOR I=1 TO DCOUNT(P<1>,@VM)
KEY=P<1,I>
BEGIN CASE
CASE INT(R.ID)
BPI='LS.ADDRESS' ; TABLE.NAME='LS_ADDRESS_NF' ; EXIT
CASE R.ID=KEY ;* 00*00
BPI=P<4,I> ; TABLE.NAME=P<3,I> ; EXIT
CASE KEY[1,1]='*'
IF FIELD(R.ID,'*',2) = FIELD(KEY,'*',2) THEN BPI=P<4,I> ; TABLE.NAME=P<3,I> ; EXIT
CASE INDEX(KEY,'*',1) > 1
IF FIELD(R.ID,'*',1):'!' = FIELD(KEY,'*',1):'!' THEN BPI=P<4,I> ; TABLE.NAME=P<3,I> ; EXIT
END CASE
NEXT I
RETURN
*
GET.FILE.METADATA.IL9:
* Get metadata for a file in IL9 from REV.ATB.LOG
BPI=FILE.NAME
GOSUB GET.BPI
FOR I=1 TO DCOUNT(BPI.REC,@AM)
ATB=BPI.REC<I>
FILE.META<1,I>=ATB
READ AREC FROM REV.ATB.LOG,ATB ELSE AREC=''
FILE.META<2,I>=AREC<14> ;* S, MV, MS
FILE.META<3,I>=AREC<10> ;* Mask, E.g. MR2, D4/, MTS
NEXT I
TABLE.NAME=TMP.FILE.NAME
RETURN
*
GET.FILE.METADATA.IL10:
* Get metadata for a file in IL10 from METADATA_FIELDS
SELECT.COMMAND = \SELECT\
SELECT.COMMAND := \ STRING_POS, FIELD_NAME, VALUE_TYPE, FIELD_TYPE, TABLE_NAME, BPI\
SELECT.COMMAND := \ FROM METADATA_FIELDS WHERE FILE_NAME = '\:FILE.NAME:\' OR BPI = '\:BPI:\'\
SELECT.COMMAND := \ ORDER BY STRING_POS\
CALL IDS.EXECUTE.ANSI.SQL(SELECT.COMMAND,'','','',MF.REC)
BPI=MF.REC<1,6> ; TABLE.NAME=MF.REC<1,5>
FOR I=1 TO DCOUNT(MF.REC,@AM)
STRING_POS=MF.REC<I,1>
FILE.META<1,STRING_POS>=MF.REC<I,2>
FILE.META<2,STRING_POS>=MF.REC<I,3>
BEGIN CASE
CASE MF.REC<I,4>='DATE'
FILE.META<3,STRING_POS>='D4/'
CASE MF.REC<I,4>='DECIMAL'
FILE.META<3,STRING_POS>='MD2'
CASE MF.REC<I,4>='INTEGER'
FILE.META<3,STRING_POS>='MD0'
CASE MF.REC<I,4>='MONEY'
FILE.META<3,STRING_POS>='MD2'
CASE MF.REC<I,4>='TIME'
FILE.META<3,STRING_POS>='MTS'
CASE 1
FILE.META<3,STRING_POS>='' ;* Leave all the rest alone
END CASE
NEXT I
RETURN
*
VIEW.RECORD:
* View a record in a file, showing field names and values
FILE.NAME=FIELD(ANS,' ',2)
CALL FILE.OPEN.OK(FILE.NAME, F.FILE, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Error opening ':FILE.NAME ; RETURN
R.ID=FIELD(ANS,' ',3)
GOSUB GET.FILE.METADATA
MAT RECORD.DATA='' ; RECORDS='' ; FLD=3 ; REC.NO=1 ; MAX.REC.COUNT=0
LOOP
R.ID=FIELD(ANS,' ',FLD)
UNTIL R.ID='' DO
RECORDS<-1>=R.ID
IF IL.MAJOR.VER=9 THEN
READ R1 FROM F.FILE, R.ID ELSE CRT 'Cannot read ':FILE.NAME:' ':R.ID ; RETURN
END ELSE
CALL IDS.READ(R1, F.FILE, R.ID, 0, 0, BCI.ERROR)
IF BCI.ERROR # '' THEN PRINT BCI.ERROR:' ':R.ID ; RETURN
END
RECORD.DATA(REC.NO)=R1
MAX.REC.NO=REC.NO
REC.COUNT=DCOUNT(R1,@AM)
IF REC.COUNT>MAX.REC.COUNT THEN MAX.REC.COUNT=REC.COUNT
REC.NO+=1
IF REC.NO=11 THEN CRT 'Too many records' ; RETURN
FLD+=1
REPEAT
COL.WID=INT((TERM.WIDTH-25)/MAX.REC.NO)-1
MSK='L#':COL.WID
*
FOR I=1 TO MAX.REC.COUNT
ATB=FILE.META<1,I> ; TYPE=FILE.META<3,I>
CRT I 'R#3':') ':
IF FILE.META # '' THEN CRT ATB'L#20':
FOR REC.NO=1 TO MAX.REC.NO
VALUE=RECORD.DATA(REC.NO)<I>
GOSUB VIEW.RECORD.ATB
CRT '|':VALUE[1,COL.WID]:SPACE(COL.WID-LEN(VALUE)):
NEXT REC.NO
CRT ''
NEXT I
RETURN
*
VIEW.RECORD.ATB:
* Format a field value for VIEW.RECORD
IF VALUE='' THEN RETURN
FOR M=1 TO DCOUNT(VALUE<1>,@VM)
BEGIN CASE
CASE TYPE='D4/'
VALUE<1,M>=OCONV(VALUE<1,M>,'D4-YMD')
CASE TYPE[1,3]='MD2'
VALUE<1,M>=OCONV(VALUE<1,M>,'MR2,')
END CASE
NEXT M
CONVERT @VM TO '|' IN VALUE
RETURN
*
FIND.MENU:
* Find a menu or program in the menu system, breadth first search
OPEN "DB.MENUS" TO MENU.F ELSE CRT 'Cannot open DB.MENUS' ; RETURN
STR=FIELD(ANS,' ',2)
IF STR='' THEN
PRINT "Enter menu or program to search for : ": ; INPUT STR
IF STR="" OR STR="/" THEN RETURN
END
STR = OCONV(STR,"MCU")
MENU.LIST=''
MENU.LIST<1>=1
MENU.LIST<2>=0
MENU.CTR=1
LOOP
MENU=MENU.LIST<1,MENU.CTR>
PATH=MENU.LIST<2,MENU.CTR>
IF MENU='' THEN EXIT
GOSUB SEARCH.MENU
MENU.CTR+=1
REPEAT
CLOSE MENU.F
RETURN
*
SEARCH.MENU:
* Search a menu for a string, add any menus found to MENU.LIST so they are searched too
READ R FROM MENU.F, MENU THEN
TITLES = OCONVS(R<2>,"MCU") ; PROGS = OCONVS(R<3>,"MCU") ; FLAGS = R<4> ; TYPES = R<5>
I = DCOUNT(PROGS,@VM)
FOR F = 1 TO I
IF INDEX(PROGS<1,F>,STR,1) # 0 OR INDEX(TITLES<1,F>,STR,1) # 0 THEN
PRINT MENU"R#5":" ":TITLES<1,F>"L#27":" ":TYPES<1,F>'L#1':" ":PROGS<1,F>"L#50":" ":PATH:',':F
END
IF FLAGS<1,F>='M' THEN MENU.LIST<1,-1>=PROGS<1,F> ; MENU.LIST<2,-1>=PATH:',':F
NEXT F
END
RETURN
*
CI:
* CONTRACT INQUIRY, wrapper around CMAINT.00
GOSUB REMOVE.CONTROL.CHARS ;* Pasting from excel often brings in a CR or  
CONTRACT=FIELD(ANS,' ',2)
DATA 0
DATA 0
DATA 0
DATA 0
IF CONTRACT # '' THEN
CONVERT '_' TO '-' IN CONTRACT
CONVERT '.' TO '-' IN CONTRACT
DATA FIELD(CONTRACT,'-',1)
DATA FIELD(CONTRACT,'-',2,2)
END
EXEC.LINE=\CMAINT.00\ ; GOSUB EXEC.SUB
RETURN
*
CM:
* CONTRACT MAINTENANCE, wrapper around CMAINT.00
GOSUB REMOVE.CONTROL.CHARS ;* Pasting from excel often brings in a CR or  
CONTRACT=FIELD(ANS,' ',2)
DATA 1
DATA 0
DATA 0
DATA 0
IF CONTRACT # '' THEN
CONVERT '_' TO '-' IN CONTRACT
CONVERT '.' TO '-' IN CONTRACT
DATA FIELD(CONTRACT,'-',1)
DATA FIELD(CONTRACT,'-',2,2)
END
EXEC.LINE=\CMAINT.00\ ; GOSUB EXEC.SUB
RETURN
*
CCI:
* CUSTOMER INQUIRY
GOSUB REMOVE.CONTROL.CHARS ;* Pasting from excel often brings in a CR or  
DATA 0
DATA 0
DATA 0
IF FIELD(ANS,' ',2) # '' THEN
DATA FIELD(ANS,' ',2)
END
EXEC.LINE=\CDMAINT.00\ ; GOSUB EXEC.SUB
RETURN
*
CCM:
* CUSTOMER MAINTENANCE
GOSUB REMOVE.CONTROL.CHARS ;* Pasting from excel often brings in a CR or  
DATA 1
DATA 0
DATA 0
IF FIELD(ANS,' ',2) # '' THEN
DATA FIELD(ANS,' ',2)
END
EXEC.LINE=\CDMAINT.00\ ; GOSUB EXEC.SUB
RETURN
*
TM:
* TABLE MAINTENANCE
DATA 1
DATA 0
EXEC.LINE=\TMAINT.00\ ; GOSUB EXEC.SUB
RETURN
*
RS:
DATA 1
DATA 1
RECALL=FIELD(ANS,' ',2)
IF RECALL # '' THEN DATA RECALL
EXECUTE \RECALL.00\
RETURN
*
ATB.FIND:
* Search for an ATB in REV.ATB.LOG
* HCAC>AF NUM.OF.ASSETS
* NUM.OF.ASSETS
*
* IL.BPI BILLING
* FILE(S) LS.MASTER,LS.BILLING PT.PARTICIPATIONS,PT.BILLING
* FIELD 9
* CHANGE LOG INDEX 02*0009
* CHANGE LOG KEY 247
* TYPE INTEGER
* MASK MD0
* S/MV S
* CONTROLLING/DEPENDENT
* SUB/MASTER FIELDS
* CHG DESCRIPTION Number Of Assets
* The number of active assets associated with the contract.
*
CALL FILE.OPEN.OK("IL.TB.CHNG.LOG", IL.TB.CHNG.LOG, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Cannot open IL.TB.CHNG.LOG' ; RETURN
CALL FILE.OPEN.OK("IL.CHANGE.LOG.INDEX", IL.CHANGE.LOG.INDEX, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Cannot open IL.CHANGE.LOG.INDEX' ; RETURN
CALL FILE.OPEN.OK("REV.ATB.LOG", REV.ATB.LOG, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Cannot open REV.ATB.LOG' ; RETURN
CALL FILE.OPEN.OK("HELP.TEXT.USA", HELP.TEXT.USA, FILE.OPEN.OK)
IF NOT(FILE.OPEN.OK) THEN CRT 'Cannot open HELP.TEXT.USA' ; RETURN
MSK="L#22"
ATB = FIELD(ANS," ",2)
IF ATB="" THEN RETURN
IF IL.MAJOR.VER=9 THEN
BCI.ERROR=''
READ AREC FROM REV.ATB.LOG, ATB ELSE BCI.ERROR='CANNOT READ REV.ATB.LOG ':ATB
END ELSE
CALL IDS.READ(AREC, REV.ATB.LOG, ATB, 0, 0, BCI.ERROR)
END
IF BCI.ERROR THEN
ATBREC=""
IF IL.MAJOR.VER=9 THEN
EXEC.LINE=\SSELECT REV.ATB.LOG = "[\:ATB:\]"\
CRT EXEC.LINE
GOSUB EXEC.SUB
END ELSE
SELECT.COMMAND=\SELECT ALTERNATE_ID FROM REV_ATB_LOG_NF WHERE ALTERNATE_ID LIKE '%\:ATB:\%' ORDER BY ALTERNATE_ID\
CRT SELECT.COMMAND
CALL IDS.EXECUTE.ANSI.SQL.ERROR(SELECT.COMMAND, '', '', '', KEY.LIST, ERR, '', '', '', '0', '','')
SELECT KEY.LIST
END
CTR=0
LOOP
READNEXT ID ELSE EXIT
IF ID='' THEN CONTINUE
CTR+=1
PRINT CTR "L#4":ID
ATBREC<CTR>=ID
REPEAT
IF CTR=0 THEN RETURN
PRINT
PRINT "Enter choice (1-":CTR:"): ": ; INPUT CHOICE
IF CHOICE="" OR CHOICE="/" THEN RETURN
ATB=ATBREC<CHOICE>
IF ATB="" THEN RETURN
IF IL.MAJOR.VER=9 THEN
BCI.ERROR=''
READ AREC FROM REV.ATB.LOG, ATB ELSE BCI.ERROR='ERROR REV.ATB.LOG ':ATB
END ELSE
CALL IDS.READ(AREC, REV.ATB.LOG, ATB, 0, 0, BCI.ERROR)
END
IF BCI.ERROR THEN
CRT ATB:' not found in REV.ATB.LOG' ; RETURN
END
END
*
MAXV=DCOUNT(AREC<5>,@VM)
FNAMES=""
FOR J=1 TO MAXV
IF AREC<5,J>[1,2] # "BK" THEN FNAMES :=AREC<5,J>:",":AREC<6,J>:" "
NEXT J
*
IF IL.MAJOR.VER=9 THEN
BCI.ERROR=''
READV CKEY FROM IL.CHANGE.LOG.INDEX, AREC<24>, 1 ELSE BCI.ERROR='ERROR IL.CHANGE.LOG.INDEX ':AREC<24>
END ELSE
CALL IDS.READV(CKEY, IL.CHANGE.LOG.INDEX, AREC<24>, '', 1, 0, 0, BCI.ERROR)
END
IF BCI.ERROR THEN CKEY=""
IF IL.MAJOR.VER=9 THEN
BCI.ERROR=''
READ CHNG_REC FROM IL.TB.CHNG.LOG, CKEY ELSE BCI.ERROR='ERROR IL.TB.CHNG.LOG ':CKEY
END ELSE
CALL IDS.READ(CHNG_REC, IL.TB.CHNG.LOG, CKEY, 0, 0, BCI.ERROR)
END
IF BCI.ERROR THEN CHNG_REC=""
IF IL.MAJOR.VER=9 THEN
BCI.ERROR=''
READ HELP.TEXT FROM HELP.TEXT.USA, ATB ELSE BCI.ERROR='ERROR HELP.TEXT.USA ':ATB
END ELSE
CALL IDS.READ(HELP.TEXT, HELP.TEXT.USA, ATB, 0, 0, BCI.ERROR)
END
IF BCI.ERROR THEN HELP.TEXT=""
CONVERT "~" TO "" IN HELP.TEXT
DEP=AREC<16>
CONVERT @VM TO "," IN DEP
PRINT ATB
PRINT
PRINT "IL.BPI" MSK :AREC<1>
PRINT "FILE(S)" MSK :FNAMES
PRINT "FIELD" MSK :AREC<2>
PRINT "CHANGE LOG INDEX" MSK :AREC<24>
PRINT "CHANGE LOG KEY" MSK :CKEY
PRINT "TYPE" MSK :AREC<3>
PRINT "MASK" MSK :AREC<10>
PRINT "S/MV" MSK :AREC<14>
PRINT "CONTROLLING/DEPENDENT" MSK:AREC<15>
PRINT "SUB/MASTER FIELDS" MSK :DEP
PRINT "CHG DESCRIPTION" MSK :CHNG_REC<1>
PRINT "COMMENTS" MSK :AREC<32>
PRINT
MAXV=DCOUNT(HELP.TEXT<2>,@VM)
FOR J=1 TO MAXV
PRINT HELP.TEXT<2,J>
NEXT J
RETURN
*
LISTA:
* List users logged in, as well as locks
IF IL.MAJOR.VER=9 THEN GOSUB LISTA.IL9 ELSE GOSUB LISTA.IL10
RETURN
*
LISTA.IL9:
* List all users/locks in IL9
OPEN 'ACC' TO ACC.F ELSE STOP 201,'ACC'
OPEN 'INFO.STATUS' TO INFO.STATUS ELSE STOP 201,'INFO.STATUS'
SELECT ACC.F
USER.LIST=''
LOOP
READNEXT PORT ELSE EXIT
READ REC FROM ACC.F, PORT THEN
READ MENU FROM INFO.STATUS, PORT'R%3' ELSE MENU='TCL'
MENU=MENU<DCOUNT(MENU,@AM)> ;* Show the last item
USER=REC<5>
DATE=REC<2>
TIME=REC<3>
LOCATE PORT IN USER.LIST<4> BY 'AR' SETTING POS ELSE NULL
INS USER BEFORE USER.LIST<1,POS>
INS DATE BEFORE USER.LIST<2,POS>
INS TIME BEFORE USER.LIST<3,POS>
INS PORT BEFORE USER.LIST<4,POS>
INS MENU BEFORE USER.LIST<5,POS>
END
REPEAT
*GET.LOCKS
LOCK.LIST=''
FLIST=''
FLIST<-1>='AS.FEATURE'
FLIST<-1>='AS.MASTER'
FLIST<-1>='AUVB.PARAMETER'
FLIST<-1>='BQ.PARAMETER'
FLIST<-1>='CS.MASTER'
FLIST<-1>='DATA.MASKING.PARAMETER'
FLIST<-1>='DB.RECORD.LOCKS'
FLIST<-1>='DE.MASTER'
FLIST<-1>='FIELD.SECURITY'
FLIST<-1>='INFO-SYSTEM'
FLIST<-1>='IT.INSURANCE'
FLIST<-1>='IT.INSURANCE.AGENT'
FLIST<-1>='LS.BANK.DEPOSIT'
FLIST<-1>='LS.DISCOUNT.PACKAGE'
FLIST<-1>='LS.DISCOUNT.WORKSHEET'
FLIST<-1>='LS.GL.HISTORY'
FLIST<-1>='LS.MASTER'
FLIST<-1>='LS.POST.DATED.CHECK'
FLIST<-1>='LS.SUPER.QUOTE'
FLIST<-1>='LS.WK.CASH'
FLIST<-1>='MISC'
FLIST<-1>='MM.GROUP'
FLIST<-1>='PARAMETER'
FLIST<-1>='PROCESSOR.PARAMETER'
FLIST<-1>='TRED.FUTURE.PROC.DATES'
FLIST<-1>='USERS.MENUS'
FLIST<-1>='WL.FOLLOW.UP'
FLIST<-1>='WL.PARAMETER'
*
FOR G=1 TO DCOUNT(FLIST,@AM)
FILE='DB.RECORD.LOCKS,':FLIST<G>
OPEN FILE TO FVAR THEN
SELECT FVAR
LOOP
READNEXT LOCK.ID ELSE EXIT
READ REC FROM FVAR, LOCK.ID THEN
PORT=REC<1>
DATE=REC<2>
TIME=REC<3>
USER=REC<4>
LOCK.LIST<1,-1>=FILE
LOCK.LIST<2,-1>=LOCK.ID
LOCK.LIST<3,-1>=PORT
LOCK.LIST<4,-1>=DATE
LOCK.LIST<5,-1>=TIME
LOCK.LIST<6,-1>=USER
LOCATE PORT IN USER.LIST<4> SETTING POS THEN
USER.LIST<6,POS>=LOCK.ID:',':USER.LIST<6,POS>
END
END
REPEAT
CLOSE FVAR
END
NEXT G
*
PRINT @(-1):'USERS'
PRINT
PRINT 'Port':' ':'User''L#12':' ':'Date''L#10':' ':'Time''L#8':' ':
PRINT 'Time On''L#8':' ':'Menu''L#30':' ':'L'
PRINT '----':' ':STR('-',12):' ':STR('-',10):' ':STR('-',8):' ':
PRINT STR('-',8):' ':STR('-',30):' ':'-'
FOR F=1 TO DCOUNT(USER.LIST<1>,@VM)
DUR=TIME()-USER.LIST<3,F>
IF DUR<0 THEN DUR+=86400 ;* Roll over midnight, add back number of seconds in a day
PRINT USER.LIST<4,F>'R#4':' ':
PRINT USER.LIST<1,F>'L#12':' ':
PRINT USER.LIST<2,F>'D4/':' ':
PRINT USER.LIST<3,F>'MTS':' ':
PRINT DUR'MTS':' ':
PRINT USER.LIST<5,F>'L#30':' ':
IF USER.LIST<6,F>#'' THEN PRINT '*' ELSE PRINT ' '
NEXT F
*
PRINT
PRINT 'LOCKS'
PRINT
PRINT 'Table''L#20':' ':'ID''L#25':' ':'Port''L#4':' ':
PRINT 'Date''L#5':' ':'Time''L#5':' ':'User''L#15'
PRINT STR('-',20):' ':STR('-',25):' ':STR('-',4):' ':
PRINT STR('-',5):' ':STR('-',5):' ':STR('-',15)
FOR L=1 TO DCOUNT(LOCK.LIST<1>,@VM)
FILE=FIELD(LOCK.LIST<1,L>,',',2)
PRINT FILE'L#20':' ':LOCK.LIST<2,L>'L#25':' ':LOCK.LIST<3,L>'R#4':' ':
PRINT (LOCK.LIST<4,L>'D4/')[1,5]:' ':LOCK.LIST<5,L>'MT':' ':LOCK.LIST<6,L>'L#15'
NEXT L
*
CLOSE ACC.F
CLOSE INFO.STATUS
*
RETURN
*
LISTA.IL10:
* List all users/locks in IL10
CRT 'User Sessions'
CRT '-------------'
SELECT.HDR=\USER_ID,LOGIN_FROM,LOGIN_DATE,LAST_ACTIVITY,CURR_TIME\
SELECT.COMMAND=\SELECT USER_ID,LOGIN_FROM,LOGIN_DATE,LAST_ACTIVITY,CURRENT_TIMESTAMP \
SELECT.COMMAND:=\FROM SYSTEM_SESSION ORDER BY USER_ID\
EMAIL=''
GOSUB IL10.SEL
CRT ''
CRT 'Record Locks'
CRT '------------'
*
* Kudos to whoever at IDS cleaned up the mess that is IL9 locking!
SELECT.HDR=\FILE_NAME,ID,LOCKED_USER,LOCKED_DATE\
SELECT.COMMAND=\SELECT FILE_NAME,ID,LOCKED_USER,LOCKED_DATE\
SELECT.COMMAND:=\ FROM DB_RECORD_LOCKS ORDER BY FILE_NAME,ID\
GOSUB IL10.SEL
CRT ''
CRT 'Processing Flags'
CRT '----------------'
*
* Show processing flags
SELECT.HDR=\USER_ID,UPDATE_CODE,UPDATE_CODE_DATE,UPDATE_CODE_DESC\
SELECT.COMMAND=\SELECT SS.USER_ID, SP.UPDATE_CODE, SP.UPDATE_CODE_DATE, SP.UPDATE_CODE_DESC \
SELECT.COMMAND:=\FROM SESSION_PORTS SP LEFT OUTER JOIN SYSTEM_SESSION SS ON SS.SESSION_ID = SP.SESSION_ID \
SELECT.COMMAND:=\WHERE UPDATE_CODE <> 0\
GOSUB IL10.SEL
RETURN
*
SEARCH.EXAMPLE:
* Calculate all possible ATB's for an example contract
IF IL.MAJOR.VER # 9 THEN PRINT 'Only works in IL9' ; RETURN
FILE=FIELD(ANS,' ',2)
@ID=FIELD(ANS,' ',3)
IF FILE='' OR @ID='' THEN
PRINT 'Usage: SE <FNAME> <ID>'
RETURN
END
OPEN FILE TO F ELSE PRINT 'Cannot open ':FILE ; RETURN
OPEN "DICT ":FILE TO @DICT ELSE PRINT 'Cannot open DICT ':FILE ; RETURN
READ @RECORD FROM F, @ID ELSE PRINT 'Cannot read ':@ID:' in ':FILE ; RETURN
CLOSE F
OUTPUT=''
EXECUTE \SSELECT DICT \:FILE:\ WITH F1 = "I" USING DICT VOC\
LOOP
READNEXT FLD ELSE EXIT
PRINT FLD:'=':
VAL=CALCULATE(FLD)
PRINT VAL
IF @CONV # '' THEN VAL=OCONV(VAL,@CONV)
*OUTPUT<-1>=FLD:'=':VAL
REPEAT
WRITE OUTPUT ON VOC, 'OUTPUT.TMP'
EXECUTE \AE VOC OUTPUT.TMP\
RETURN
*
IL10.XREF:
* Show metadata cross reference for a file or table. Works best given an IL9 FILE.NAME like XREF LS.MASTER,LS.BILLING
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
FILE.NAME = FIELD(ANS,' ',2)
FIELD.NAME = FIELD(ANS,' ',3)
SELECT.HDR=\BPI,FILE_NAME,FIELD_NAME,STRING_POS,TABLE_NAME,COLUMN_NAME,VALUE_TYPE,FIELD_TYPE\
SELECT.COMMAND = \SELECT\
SELECT.COMMAND := \ BPI, FILE_NAME, FIELD_NAME, STRING_POS, TABLE_NAME, COLUMN_NAME, VALUE_TYPE, FIELD_TYPE\
IF INDEX(FILE.NAME,'%',1) THEN
SELECT.COMMAND := \ FROM METADATA_FIELDS WHERE (FILE_NAME LIKE '\:FILE.NAME:\' OR TABLE_NAME LIKE '\:FILE.NAME:\')\
END ELSE
SELECT.COMMAND := \ FROM METADATA_FIELDS WHERE (FILE_NAME = '\:FILE.NAME:\' OR TABLE_NAME = '\:FILE.NAME:\')\
END
IF FIELD.NAME # '' THEN SELECT.COMMAND :=\ AND FIELD_NAME LIKE '%\:FIELD.NAME:\%'\
SELECT.COMMAND := \ ORDER BY FILE_NAME, STRING_POS\
*
EMAIL=''
GOSUB IL10.SEL
RETURN
*
IL10.FIELD:
* Show all ATB's for a file from METADATA_FIELDS, e.g. FIELD RENEWAL
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
FLD = FIELD(ANS,' ',2)
SELECT.HDR=\BPI,FILE_NAME,FIELD_NAME,MV_POS,TABLE_NAME,COLUMN_NAME,MV/S,TYPE,LEN,SCALE\
SELECT.COMMAND = \SELECT BPI,FILE_NAME,FIELD_NAME,STRING_POS,TABLE_NAME,COLUMN_NAME,VALUE_TYPE,FIELD_TYPE,FIELD_LENGTH,SCALE\
SELECT.COMMAND :=\ FROM METADATA_FIELDS\
SELECT.COMMAND :=\ WHERE FIELD_NAME LIKE '%\:FLD:\%' OR COLUMN_NAME LIKE '%\:FLD:\%'\
EMAIL=''
GOSUB IL10.SEL
RETURN
*
IL10.DESC:
* Show SQL table structure, this gets some columns not shown in META_DATA_FIELDS, but still doesn't include COMPUTED columns
TABLE = FIELD(ANS,' ',2)
SELECT.HDR=\COL,COLUMN_NAME,DATA_TYPE,WIDTH\
IF DB='ORA' THEN
SELECT.COMMAND = \SELECT COLUMN_ID, COLUMN_NAME, DATA_TYPE, CHAR_COL_DECL_LENGTH \
SELECT.COMMAND:= \FROM ALL_TAB_COLUMNS \
SELECT.COMMAND:= \WHERE TABLE_NAME = '\:TABLE:\'\
END ELSE
SELECT.COMMAND = \SELECT ORDINAL_POSITION, COLUMN_NAME, DATA_TYPE, CHARACTER_MAXIMUM_LENGTH \
SELECT.COMMAND:= \FROM INFORMATION_SCHEMA.COLUMNS \
SELECT.COMMAND:= \WHERE TABLE_NAME = '\:TABLE:\'\
END
SELECT.COMMAND:= \ORDER BY 1\
EMAIL=''
GOSUB IL10.SEL
RETURN
*
IL10.NSEL:
* Run a SELECT statement and display the results
PRMT=1
EXECLINE='SELECT ':FIELD(ANS,' ',2,999)
CALL EXECUTE.SELECT.SUB(EXECLINE,ERR.MSG,1,'',0,SELECTED.LIST,1,'',0,'',0,0)
CTR=0
LOOP
READNEXT ID FROM SELECTED.LIST ELSE EXIT
CTR+=1
CRT CTR'R#6':') ':ID
IF CTR/20=INT(CTR/20) AND PRMT THEN
CRT ':':
INPUT AAA
IF AAA = '/' OR AAA='Q' THEN RETURN
IF AAA = 'N' THEN PRMT=0
END
REPEAT
RETURN
*
SQL.SEL:
* Run a SELECT statement from the command line and display the results, e.g. SQL SELECT COUNT(*) FROM WK_INVOICE_NF
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
SELECT.HDR=''
SELECT.COMMAND=FIELD(ANS,' ',2,200)
EMAIL=''
GOSUB IL10.SEL
RETURN
*
SQL.FILE:
* Run a SELECT statement from a file and display the results, e.g. SQLF _HOLD_ TEST.sql
* This expects the first line of the SQL file to be a comment containing delimited field names
* It jams all lines in the file together before executing, so use /* Comments */ NOT -- Comments
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
SELECT.HDR=''
FILE=FIELD(ANS,' ',2) ;* Spaces in file name are not supported
EMAIL=FIELD(ANS,' ',3)
OSREAD SELECT.COMMAND FROM FILE ELSE CRT FILE:' not found' ; RETURN
IF SELECT.COMMAND<1>[1,2]='--' THEN
SELECT.HDR=SELECT.COMMAND<1>[3,999]
CONVERT CHAR(9) TO @VM IN SELECT.HDR
DEL SELECT.COMMAND<1>
END
CONVERT @AM TO ' ' IN SELECT.COMMAND
SWAP CHAR(13):CHAR(10) WITH ' ' IN SELECT.COMMAND
* Check for parameter requests before running SQL
LOOP
I=INDEX(SELECT.COMMAND,'@',1)
UNTIL I=0 DO
I+=1 ; P='' ; DONE=0
LOOP
C=SELECT.COMMAND[I,1]
IF (C < 'A' OR C > 'Z') AND C # '_' AND C # '.' THEN DONE=1
UNTIL DONE DO
P:=C
I+=1
REPEAT
CRT 'Enter a value for ':P:':':
INPUT VAL
SWAP '@':P WITH VAL IN SELECT.COMMAND
REPEAT
GOSUB IL10.SEL
RETURN
*
SQL.SEL.LIST:
* This runs a SQL command and saves the results to a list, e.g. SQL-LIST L1 SELECT TOP 10 ALTERNATE_ID FROM LS_MASTER_NF
* Will run the SQL and save the results to a saved list
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
LIST=FIELD(ANS,' ',2)
SELECT.COMMAND=FIELD(ANS,' ',3,200)
FIRST.WORD=FIELD(ANS,' ',3)
IF FIRST.WORD = 'SELECT' THEN
PRINT SELECT.COMMAND
PARAM=''
CALL IDS.EXECUTE.ANSI.SQL(SELECT.COMMAND,PARAM,'','',KEY.LIST)
CALL CONVERT.LIST(KEY.LIST)
EXECUTE \SAVE.LIST \:LIST PASSLIST KEY.LIST
END ELSE
* Assume we're running from a file
SELECT.HDR=''
FILE=FIELD(ANS,' ',3) ;* Spaces in file name are not supported
OSREAD SELECT.COMMAND FROM FILE ELSE CRT FILE:' not found' ; RETURN
CONVERT CHAR(13) TO '' IN SELECT.COMMAND
CONVERT CHAR(10) TO ' ' IN SELECT.COMMAND
PARAM=''
FOR F=DCOUNT(SELECT.COMMAND,@AM) TO 1 STEP -1
IF SELECT.COMMAND<F>[1,2]='--' THEN DEL SELECT.COMMAND<F>
NEXT F
CRT SELECT.COMMAND
CALL IDS.EXECUTE.ANSI.SQL(SELECT.COMMAND,PARAM,'','',KEY.LIST)
CALL CONVERT.LIST(KEY.LIST)
EXECUTE \SAVE.LIST \:LIST PASSLIST KEY.LIST
END
RETURN
*
IL10.SEL:
* Run a SELECT statement and display the results
IF IL.MAJOR.VER # 10 THEN PRINT 'Only works in IL10' ; RETURN
PARAM=''
CONVERT ',' TO @VM IN SELECT.HDR
IF SHOW.SELECT THEN PRINT SELECT.COMMAND ; PRINT
CALL IDS.EXECUTE.ANSI.SQL.ERROR(SELECT.COMMAND, PARAM, '', '', KEY.LIST, ERR, '', '', '', '0', '','')
DISP.MAX=DCOUNT(KEY.LIST,@AM)
PRINT DISP.MAX:' items selected, ERR=':ERR
IF DISP.MAX=0 THEN RETURN
IF EMAIL # '' THEN
CSV.FILE=FILE:'.csv'
CONVERT ',' TO '|' IN KEY.LIST ;* Deal with embedded commas in the data
CONVERT @VM TO ',' IN KEY.LIST
IF SELECT.HDR # '' THEN
CONVERT @VM TO ',' IN SELECT.HDR
INS SELECT.HDR BEFORE KEY.LIST<1>
END
SWAP @AM WITH CHAR(10) IN KEY.LIST
WRITE KEY.LIST ON F.HOLD, CSV.FILE
CALL STACK.MAIL.SUB('@LOGNAME', '@LOGNAME', '_HOLD_/':CSV.FILE, CSV.FILE, 'PATH')
END ELSE
* Get widths
CONVERT ',' TO @VM IN SELECT.HDR
W=''
IF SELECT.HDR # '' THEN
INS SELECT.HDR BEFORE KEY.LIST<1>
DISP.MAX+=1
END
FOR R=1 TO 100 ;* Just check the first 100 rows for widths
IF KEY.LIST<R>='' THEN EXIT
FOR C=1 TO DCOUNT(KEY.LIST<R>,@VM)
L=LEN(KEY.LIST<R,C>)
IF L > W<C> THEN W<C>=L
NEXT C
NEXT R
*
* Print the header
DISP.START=1
IF SELECT.HDR # '' THEN
DISP.START=2
FOR C=1 TO DCOUNT(KEY.LIST<1>,@VM)
PRINT FMT(KEY.LIST<1,C>,'L#':W<C>):' ':
NEXT C
PRINT
*
FOR C=1 TO DCOUNT(KEY.LIST<1>,@VM)
PRINT STR('-',W<C>):' ':
NEXT C
PRINT
END
* Now the data
FOR R=DISP.START TO DISP.MAX
IF SELECT.HDR = '' THEN CRT R,:
FOR C=1 TO DCOUNT(KEY.LIST<R>,@VM)
PRINT FMT(KEY.LIST<R,C>,'L#':W<C>):' ':
NEXT C
PRINT
NEXT R
END
RETURN
*
LIST.MODULES:
* List all modules in the system
IF IL.MAJOR.VER # 9 THEN PRINT 'Only works in IL9' ; RETURN
OPEN 'MODULE.FILE,IL' TO MODULES ELSE CRT 'ERROR OPENING:MODULES' ; RETURN
OPEN 'IL.APP.PARAMS' TO IL.APP.PARAMS ELSE CRT 'ERROR OPENING:IL.APP.PARAMS' ; RETURN
OPEN 'ACCOUNT.PARAMS' TO ACCOUNT.PARAMS ELSE CRT 'ERROR OPENING:ACCOUNT.PARAMS' ; RETURN
READ PARAMS FROM ACCOUNT.PARAMS, 'VERSION' ELSE PARAMS=''
MODULES.ACTIVE=PARAMS<1>
SYSNUM=PARAMS<11>
READ R FROM IL.APP.PARAMS, SYSNUM:'*MODULES' ELSE R=''
FOR F=1 TO LEN(R)
M=R[F,1]
IF M=1 THEN
READV DESC FROM MODULES, F, 1 ELSE DESC='Unknown'
CRT F 'R#3':' ':MODULES.ACTIVE[F,1]:' ':DESC
END
NEXT F
RETURN
*
LIST.PARAM:
* List PARAMETER records, also used from GET.PARAMETER.BPI for XREF info
* 1=PREFIX
* 2=DESCRIPTION
* 3=TABLE NAME
* 4=BPI
P=''
P<1,-1>=STR('-', 18) ; P<2,-1>=STR('-',33)
P<3,-1>=STR('-',30) ; P<4,-1>=STR('-',30)
P<1,-1>='Key Prefix' ; P<2,-1>='Description'
P<3,-1>='RDBMS Table' ; P<4,-1>='BPI'
P<1,-1>=STR('-', 18) ; P<2,-1>=STR('-',33)
P<3,-1>=STR('-',30) ; P<4,-1>=STR('-',30)
P<1,-1>='00*00' ; P<2,-1>='Lease System Parameters'
P<3,-1>='PARAMETER_NF' ; P<4,-1>='PARAMETER'
P<1,-1>='00*00A' ; P<2,-1>='Temporary Lease System Params'
P<3,-1>='TEMP_PARAMETER_NF' ; P<4,-1>='TEMP.PARAMETER'
P<1,-1>='00*00B' ; P<2,-1>='Additional Lease System Params'
P<3,-1>='ADDL_PARAMETER_NF' ; P<4,-1>='ADDL.PARAMETER'
P<1,-1>='00*00IRR' ; P<2,-1>='IRR Parameter'
P<3,-1>='IRR_PARAMETER_NF' ; P<4,-1>='IRR.PARAMETER'
P<1,-1>='00*00RPT' ; P<2,-1>='Report Parameter'
P<3,-1>='RPT_PARAMETER_NF' ; P<4,-1>='RPT.PARAMETER'
P<1,-1>='*00' ; P<2,-1>='Lessor Parameters'
P<3,-1>='LESSOR_NF' ; P<4,-1>='LESSOR'
P<1,-1>='*00A' ; P<2,-1>='Temporary Lessor'
P<3,-1>='TEMP_LESSOR_NF' ; P<4,-1>='TEMP.LESSOR'
P<1,-1>='*00B' ; P<2,-1>='Additional Lessor'
P<3,-1>='ADDL_LESSOR_NF' ; P<4,-1>='ADDL.LESSOR'
P<1,-1>='*00GL' ; P<2,-1>='Multiple Bookset'
P<3,-1>='MULTIPLE_BOOKSET_NF' ; P<4,-1>='MULTIPLE.BOOKSET'
P<1,-1>='*00UD' ; P<2,-1>='Lessor User-Defined'
P<3,-1>='LESSOR_USER_NF' ; P<4,-1>='LESSOR.USER'