Tweet
Hello, I am a real Noobie! I have been spending my spare time trying to learn how to program on the AS/400. I have purchased several books, printed tons of IBM Redbook documents, and now, I am hoping someone here at this forum can point out my error.
I have been writing and rewriting an example from one of the books I purchased, "Subfiles in Free-Format RPG" BY Kevin Vandever. specifically example sfl006rg, sfl006df. I have been modifying it for my purposes and once i have a working copy, I would delete it and rewrite it taking a different approach hoping the repetition would sink in. This is a simple program that, when completed, would allow you to add display, delete, and edit records. Each approach I would take in rewriting it would be to get the basic view up and going and then add 1 function at a time. My last approach was adding the delete function and for the life of my I cant figure out why its not working. I have printed the sample code out and my own code and have looked at them step by step but because of some of the name changes, I have become completely lost. So, hopefully someone her will have a laugh and show me what I am missing.
Problem: After I delete a record, the subfile doesn't show all the records in the file, minus the one deleted, only a few of them and the subfile will not load any records by pressing page-up or page-down. But, if I add a new record, the subfile will start working again, showing all records.
My mind is jumbled and I need someone to point me in the right direction, Thanks for your time!
Garrett
Physical File:
0005.00 A* 150924
0006.00 A UNIQUE 150924
0007.00 A R COLFMT TEXT('FORMAT FOR COLLECTION') 150924
0007.01 A COLID 3 0 150929
0008.00 A COLNUM 2 0 150925
0009.00 A COLNAME 45 150928
0010.00 A K COLID 150929
DSPF File:
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 1
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
10 A*%%TS SD 20150929 124132 USERNAME REL-V7R1M0 5770-WDS 09/29/15
20 A*%%EC 09/29/15
30 A DSPSIZ(24 80 *DS3) 09/29/15
40 A CF03(03 'Exit Program') 09/29/15
50 A CF06(06 'ADD COLLECTION') 09/29/15
60 A CF12(12 'CANCEL PROGRAM') 09/29/15
61 A CF07(07 'TEST') 09/29/15
70 A* 09/24/15
80 A R SUB1 SFL 09/25/15
90 A*%%TS SD 20150925 050828 USERNAME REL-V7R1M0 5770-WDS 09/25/15
100 A 74 SFLNXTCHG 09/25/15
110 A COLID R H REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
120 A OPTION 1A B 7 4VALUES(' ' '2' '4' '5' '8') 09/28/15
130 A COLNUM R O 7 8REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/25/15
140 A COLNAME R O 7 14REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/25/15
150 A R SFLCTL SFLCTL(SUB1) 09/29/15
160 A*%%TS SD 20150929 124132 USERNAME REL-V7R1M0 5770-WDS 09/29/15
170 A SFLSIZ(0015) 09/29/15
180 A SFLPAG(0014) 09/29/15
190 A ROLLUP 09/29/15
200 A OVERLAY 09/29/15
210 A N32 SFLDSP 09/29/15
220 A N31 SFLDSPCTL 09/29/15
230 A 31 SFLCLR 09/29/15
240 A 90 SFLEND(*MORE) 09/29/15
250 A RRN1 4S 0H SFLRCDNBR 09/29/15
260 A 1 3'User:' 09/29/15
270 A COLOR(RED) 09/29/15
280 A 1 9USER 09/29/15
290 A 1 67'Date:' 09/29/15
300 A COLOR(RED) 09/29/15
310 A 1 73DATE 09/29/15
320 A EDTCDE(Y) 09/29/15
330 A 2 3'BUSINESS' 09/29/15
340 A COLOR(BLU) 09/29/15
350 A 2 65'System:' 09/29/15
360 A COLOR(BLU) 09/29/15
370 A 2 73SYSNAME 09/29/15
380 A 3 3'IT Department - 09/29/15
390 A Research & De- 09/29/15
400 A velopment' 09/29/15
410 A DSPATR(UL) 09/29/15
420 A COLOR(BLU) 09/29/15
430 A 1 31'Pricebook Collection' 09/29/15
440 A COLOR(BLU) 09/29/15
450 A 6 3'Opt' 09/29/15
460 A DSPATR(UL) 09/29/15
470 A COLOR(BLU) 09/29/15
480 A 6 14'Collection Name:' 09/29/15
490 A COLOR(BLU) 09/29/15
500 A DSPATR(UL) 09/29/15
510 A 6 7'Num:' 09/29/15
520 A COLOR(BLU) 09/29/15
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 2
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
530 A DSPATR(UL) 09/29/15
540 A 5 3'Options:' 09/29/15
550 A COLOR(WHT) 09/29/15
560 A 5 12'2=Edit' 09/29/15
570 A 5 19'4=Delete' 09/29/15
580 A 5 28'5=Display' 09/29/15
590 A 5 38'8=Process' 09/29/15
610 A* 09/29/15
620 A R NEW_COL 09/29/15
630 A*%%TS SD 20150929 104347 USERNAME REL-V7R1M0 5770-WDS 09/29/15
640 A 1 3'User:' 09/29/15
650 A COLOR(RED) 09/29/15
660 A 1 9USER 09/29/15
670 A 1 67'Date:' 09/29/15
680 A COLOR(RED) 09/29/15
690 A 1 73DATE 09/29/15
700 A EDTCDE(Y) 09/29/15
710 A 2 3'BUSINESS' 09/29/15
720 A COLOR(BLU) 09/29/15
730 A 2 65'System:' 09/29/15
740 A COLOR(BLU) 09/29/15
750 A 2 73SYSNAME 09/29/15
760 A 3 3'IT Department - 09/29/15
770 A Research & De- 09/29/15
780 A velopment' 09/29/15
790 A DSPATR(UL) 09/29/15
800 A COLOR(BLU) 09/29/15
810 A 1 31'Pricebook Collection' 09/29/15
820 A COLOR(BLU) 09/29/15
830 A 6 3'ID' 09/29/15
840 A DSPATR(UL) 09/29/15
850 A COLOR(BLU) 09/29/15
860 A 6 14'Collection Name:' 09/29/15
870 A COLOR(BLU) 09/29/15
880 A DSPATR(UL) 09/29/15
890 A 6 7'Num:' 09/29/15
900 A COLOR(BLU) 09/29/15
910 A DSPATR(UL) 09/29/15
920 A COLID R O 7 3REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
930 A COLNUM R B 7 8REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/29/15
940 A COLNAME R B 7 14REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/29/15
950 A CHECK(LC) 09/29/15
960 A 5 32'Add New Collection' 09/29/15
970 A COLOR(WHT) 09/29/15
980 A* 09/24/15
981 A R WINDOW1 SFL 09/29/15
982 A COLID R O 6 7REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
983 A COLNUM R B 6 12REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/29/15
984 A COLNAME R B 6 18REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/29/15
985 A 09/29/15
986 A R SF2CTL SFLCTL(WINDOW1) 09/29/15
987 A SFLDSP 09/29/15
988 A N41 SFLDSPCTL 09/29/15
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 3
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
989 A 41 SFLCLR 09/29/15
990 A N41 SFLEND(*MORE) 09/29/15
991 A SFLSIZ(0009) 09/29/15
992 A SFLPAG(0008) 09/29/15
993 A WINDOW(2 2 20 70) 09/29/15
994 A RRN2 4S 0H 09/29/15
996 A R FKEY2 09/29/15
997 A 23 5'<F3>=Exit' 09/29/15
998 A COLOR(BLU) 09/29/15
999 A 22 2'__________________________________- 09/29/15
1000 A ___________________________________- 09/29/15
1001 A _________' 09/29/15
1002 A COLOR(BLU) 09/29/15
1003 A 23 20'<F12>=Cancel' 09/29/15
1004 A COLOR(BLU) 09/29/15
1005 A 09/29/15
1013 A R FKEY1 09/29/15
1014 A*%%TS SD 20150929 060325 USERNAME REL-V7R1M0 5770-WDS 09/29/15
1015 A 23 5'<F3>=Exit' 09/29/15
1020 A COLOR(BLU) 09/29/15
1030 A 22 2'__________________________________- 09/29/15
1040 A ___________________________________- 09/29/15
1050 A _________' 09/29/15
1060 A COLOR(BLU) 09/29/15
1070 A 23 18'<F6>=Add Collection' 09/29/15
1080 A COLOR(BLU) 09/29/15
1090 A 23 41'<F12>=Cancel' 09/29/15
1100 A COLOR(BLU) 09/29/15
* * * * E N D O F S O U R C E * * * *
RPGLE File:
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:46 SYSSERIAL PAGE 1
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCRPG
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
100 FPBCDSPF CF E WORKSTN 09/24/15
101 F SFILE(SUB1:RRN1) 09/24/15
102 F SFILE(WINDOW1:RRN2) 09/30/15
103 F Infds(Info) 09/24/15
200 FPBCLPF UF A E K DISK 09/29/15
201 09/29/15
202 09/24/15
203 DInfo DS 09/24/15
204 D CFKey 369 369 09/24/15
300 09/24/15
302 DExit C Const(X'33') 09/29/15
303 DEnter C Const(X'F1') 09/29/15
304 DAddCol C Const(X'36') 09/29/15
305 DRollup C Const(X'F5') 09/24/15
307 DSflpag C Const(14) 09/24/15
308 DCancel C Const(X'3C') 09/29/15
309 DDelete C Const('4') 09/29/15
310 09/24/15
600 DLstrrn S 4 0 Inz(0) 09/24/15
601 Dlstrrn2 S 4 0 Inz(0) 09/29/15
602 DNew_id S LIKE(ColID) 09/29/15
603 Di S 4 0 Inz(0) 09/24/15
604 09/24/15
700 /FREE 09/24/15
701 // Main Routine 09/24/15
702 Exsr Clear_Sub1; 09/24/15
800 Exsr Build_Sub1; 09/24/15
803 09/24/15
900 Dou *Inkc; 09/24/15
1300 Write Fkey1; 09/24/15
1301 Exfmt Sflctl; 09/30/15
1302 09/24/15
1303 // Select Statement 09/24/15
1304 Select; 09/24/15
1309 09/24/15
1310 // Key selection 09/29/15
1311 09/29/15
1314 //Pagedown is pressed 09/29/15
1315 When (CFKey = Rollup) and (not *In90); 09/30/15
1316 Exsr Build_Sub1; 09/28/15
1317 09/24/15
1318 //F12 is pressed 09/24/15
1319 When CFKey = Cancel; 09/24/15
1320 Leave; 09/24/15
1321 09/29/15
1326 //F6 is pressed 09/29/15
1327 When CFKey = AddCol; 09/29/15
1328 Exsr Add_Col; 09/29/15
1329 Setll (*Loval) PBCLPF; 09/29/15
1330 Exsr Clear_Sub1; 09/29/15
1331 Exsr Build_Sub1; 09/29/15
1335 09/29/15
1336 //Option Selection 09/29/15
1337 When CFKey = Enter; 09/29/15
1338 Exsr Process_Options; 09/29/15
1339 09/29/15
1340 Endsl; 09/24/15
1341 09/24/15
1400 Enddo; 09/24/15
1401 09/24/15
1402 *Inlr = *On; 09/24/15
1403 09/24/15
1404 // Sub Routines 09/24/15
1405 Begsr Clear_Sub1; 09/24/15
1406 Rrn1 = *Zero; 09/24/15
1407 Lstrrn = *Zero; 09/24/15
1408 *In31 = *On; 09/24/15
1409 Write Sflctl; 09/24/15
1410 *In31 = *Off; 09/24/15
1411 *In32 = *Off; 09/24/15
1412 *In90 = *Off; 09/24/15
1413 Endsr; 09/24/15
1414 09/24/15
1415 Begsr Build_Sub1; 09/24/15
1416 Rrn1 = Lstrrn; 09/24/15
1422 09/24/15
1423 For i = 1 to sflpag; 09/24/15
1424 Read PBCLPF; 09/25/15
1425 09/24/15
1426 If %eof; 09/30/15
1427 *In90 = *On; 09/24/15
1428 Leave; 09/24/15
1429 EndIf; 09/24/15
1430 09/24/15
1431 Rrn1 = Rrn1 + 1; 09/24/15
1432 Option = *Blank; 09/24/15
1433 Write Sub1; 09/24/15
1434 Endfor; 09/24/15
1435 09/24/15
1436 If Rrn1 = *Zero; 09/24/15
1437 *In32 = *On; 09/24/15
1438 EndIf; 09/24/15
1439 09/24/15
1440 Lstrrn = Rrn1; 09/24/15
1441 Endsr; 09/24/15
1442 09/29/15
1443 BEGSR Add_Col; 09/29/15
1444 Setgt (*Hival) PBCLPF; 09/29/15
1445 Readp PBCLPF; 09/29/15
1446 09/29/15
1447 If Not %EOF; 09/29/15
1448 New_ID = COLID + 1; 09/29/15
1449 ELSE; 09/29/15
1450 New_id = 1; 09/29/15
1451 Endif; 09/29/15
1452 09/29/15
1453 Clear COLFMT; 09/29/15
1454 COLID = New_id; 09/29/15
1455 Exfmt New_Col; 09/30/15
1456 09/29/15
1457 If (CfKey<>Exit) and (CfKey <> Cancel); 09/29/15
1458 Write COLFMT; 09/29/15
1459 EndIf; 09/29/15
1460 Endsr; 09/29/15
1461 09/29/15
1462 Begsr Delete_Record; 09/29/15
1463 For i = 1 to Lstrrn2; 09/29/15
1464 Delete (ColID) COLFMT; 09/29/15
1465 Endfor; 09/29/15
1471 Endsr; 09/29/15
1496 09/29/15
1497 Begsr Process_Options; 09/29/15
1498 09/29/15
1499 Exsr Clear_Sub2; 09/29/15
1500 Readc Sub1; 09/29/15
1501 Dow Not %eof; 09/29/15
1502 Select; 09/29/15
1503 When Option = Delete; 09/29/15
1504 Rrn2 = Rrn2 + 1; 09/29/15
1505 Write Window1; 09/29/15
1506 *In74 = *On; 09/29/15
1507 Update Sub1; 09/29/15
1508 *In74 = *Off; 09/29/15
1509 Endsl; 09/29/15
1510 Readc Sub1; 09/29/15
1511 EndDo; 09/29/15
1512 09/29/15
1513 If Rrn2 > 0; 09/29/15
1514 Lstrrn2 = Rrn2; 09/29/15
1515 Rrn2 = 1; 09/29/15
1516 Write FKey2; 09/29/15
1517 Exfmt Sf2Ctl; 09/29/15
1518 If (CFKey <> Exit) and (CFKey <> Cancel); 09/29/15
1519 Exsr Delete_Record; 09/29/15
1520 Setll (ColID) PBCLPF; 09/30/15
1521 Exsr Clear_Sub1; 09/29/15
1522 Exsr Build_Sub1; 09/29/15
1523 EndIf; 09/29/15
1524 EndIf; 09/29/15
1525 Endsr; 09/29/15
1526 09/29/15
1527 Begsr Clear_Sub2; 09/29/15
1528 Rrn2 = *Zero; 09/29/15
1529 Lstrrn2 = *Zero; 09/29/15
1530 *In41 = *On; 09/29/15
1531 Write Sf2ctl; 09/29/15
1532 *In41 = *Off; 09/29/15
1533 Endsr; 09/29/15
1534 09/29/15
1535 /END-FREE 09/24/15
* * * * E N D O F S O U R C E * * * *
I have been writing and rewriting an example from one of the books I purchased, "Subfiles in Free-Format RPG" BY Kevin Vandever. specifically example sfl006rg, sfl006df. I have been modifying it for my purposes and once i have a working copy, I would delete it and rewrite it taking a different approach hoping the repetition would sink in. This is a simple program that, when completed, would allow you to add display, delete, and edit records. Each approach I would take in rewriting it would be to get the basic view up and going and then add 1 function at a time. My last approach was adding the delete function and for the life of my I cant figure out why its not working. I have printed the sample code out and my own code and have looked at them step by step but because of some of the name changes, I have become completely lost. So, hopefully someone her will have a laugh and show me what I am missing.
Problem: After I delete a record, the subfile doesn't show all the records in the file, minus the one deleted, only a few of them and the subfile will not load any records by pressing page-up or page-down. But, if I add a new record, the subfile will start working again, showing all records.
My mind is jumbled and I need someone to point me in the right direction, Thanks for your time!
Garrett
Physical File:
0005.00 A* 150924
0006.00 A UNIQUE 150924
0007.00 A R COLFMT TEXT('FORMAT FOR COLLECTION') 150924
0007.01 A COLID 3 0 150929
0008.00 A COLNUM 2 0 150925
0009.00 A COLNAME 45 150928
0010.00 A K COLID 150929
DSPF File:
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 1
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
10 A*%%TS SD 20150929 124132 USERNAME REL-V7R1M0 5770-WDS 09/29/15
20 A*%%EC 09/29/15
30 A DSPSIZ(24 80 *DS3) 09/29/15
40 A CF03(03 'Exit Program') 09/29/15
50 A CF06(06 'ADD COLLECTION') 09/29/15
60 A CF12(12 'CANCEL PROGRAM') 09/29/15
61 A CF07(07 'TEST') 09/29/15
70 A* 09/24/15
80 A R SUB1 SFL 09/25/15
90 A*%%TS SD 20150925 050828 USERNAME REL-V7R1M0 5770-WDS 09/25/15
100 A 74 SFLNXTCHG 09/25/15
110 A COLID R H REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
120 A OPTION 1A B 7 4VALUES(' ' '2' '4' '5' '8') 09/28/15
130 A COLNUM R O 7 8REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/25/15
140 A COLNAME R O 7 14REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/25/15
150 A R SFLCTL SFLCTL(SUB1) 09/29/15
160 A*%%TS SD 20150929 124132 USERNAME REL-V7R1M0 5770-WDS 09/29/15
170 A SFLSIZ(0015) 09/29/15
180 A SFLPAG(0014) 09/29/15
190 A ROLLUP 09/29/15
200 A OVERLAY 09/29/15
210 A N32 SFLDSP 09/29/15
220 A N31 SFLDSPCTL 09/29/15
230 A 31 SFLCLR 09/29/15
240 A 90 SFLEND(*MORE) 09/29/15
250 A RRN1 4S 0H SFLRCDNBR 09/29/15
260 A 1 3'User:' 09/29/15
270 A COLOR(RED) 09/29/15
280 A 1 9USER 09/29/15
290 A 1 67'Date:' 09/29/15
300 A COLOR(RED) 09/29/15
310 A 1 73DATE 09/29/15
320 A EDTCDE(Y) 09/29/15
330 A 2 3'BUSINESS' 09/29/15
340 A COLOR(BLU) 09/29/15
350 A 2 65'System:' 09/29/15
360 A COLOR(BLU) 09/29/15
370 A 2 73SYSNAME 09/29/15
380 A 3 3'IT Department - 09/29/15
390 A Research & De- 09/29/15
400 A velopment' 09/29/15
410 A DSPATR(UL) 09/29/15
420 A COLOR(BLU) 09/29/15
430 A 1 31'Pricebook Collection' 09/29/15
440 A COLOR(BLU) 09/29/15
450 A 6 3'Opt' 09/29/15
460 A DSPATR(UL) 09/29/15
470 A COLOR(BLU) 09/29/15
480 A 6 14'Collection Name:' 09/29/15
490 A COLOR(BLU) 09/29/15
500 A DSPATR(UL) 09/29/15
510 A 6 7'Num:' 09/29/15
520 A COLOR(BLU) 09/29/15
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 2
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
530 A DSPATR(UL) 09/29/15
540 A 5 3'Options:' 09/29/15
550 A COLOR(WHT) 09/29/15
560 A 5 12'2=Edit' 09/29/15
570 A 5 19'4=Delete' 09/29/15
580 A 5 28'5=Display' 09/29/15
590 A 5 38'8=Process' 09/29/15
610 A* 09/29/15
620 A R NEW_COL 09/29/15
630 A*%%TS SD 20150929 104347 USERNAME REL-V7R1M0 5770-WDS 09/29/15
640 A 1 3'User:' 09/29/15
650 A COLOR(RED) 09/29/15
660 A 1 9USER 09/29/15
670 A 1 67'Date:' 09/29/15
680 A COLOR(RED) 09/29/15
690 A 1 73DATE 09/29/15
700 A EDTCDE(Y) 09/29/15
710 A 2 3'BUSINESS' 09/29/15
720 A COLOR(BLU) 09/29/15
730 A 2 65'System:' 09/29/15
740 A COLOR(BLU) 09/29/15
750 A 2 73SYSNAME 09/29/15
760 A 3 3'IT Department - 09/29/15
770 A Research & De- 09/29/15
780 A velopment' 09/29/15
790 A DSPATR(UL) 09/29/15
800 A COLOR(BLU) 09/29/15
810 A 1 31'Pricebook Collection' 09/29/15
820 A COLOR(BLU) 09/29/15
830 A 6 3'ID' 09/29/15
840 A DSPATR(UL) 09/29/15
850 A COLOR(BLU) 09/29/15
860 A 6 14'Collection Name:' 09/29/15
870 A COLOR(BLU) 09/29/15
880 A DSPATR(UL) 09/29/15
890 A 6 7'Num:' 09/29/15
900 A COLOR(BLU) 09/29/15
910 A DSPATR(UL) 09/29/15
920 A COLID R O 7 3REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
930 A COLNUM R B 7 8REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/29/15
940 A COLNAME R B 7 14REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/29/15
950 A CHECK(LC) 09/29/15
960 A 5 32'Add New Collection' 09/29/15
970 A COLOR(WHT) 09/29/15
980 A* 09/24/15
981 A R WINDOW1 SFL 09/29/15
982 A COLID R O 6 7REFFLD(COLFMT/COLID GDRDEV/PBCLPF) 09/29/15
983 A COLNUM R B 6 12REFFLD(COLFMT/COLNUM GDRDEV/PBCLPF) 09/29/15
984 A COLNAME R B 6 18REFFLD(COLFMT/COLNAME GDRDEV/PBCLPF) 09/29/15
985 A 09/29/15
986 A R SF2CTL SFLCTL(WINDOW1) 09/29/15
987 A SFLDSP 09/29/15
988 A N41 SFLDSPCTL 09/29/15
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:44 SYSSERIAL PAGE 3
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCDSPF
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
989 A 41 SFLCLR 09/29/15
990 A N41 SFLEND(*MORE) 09/29/15
991 A SFLSIZ(0009) 09/29/15
992 A SFLPAG(0008) 09/29/15
993 A WINDOW(2 2 20 70) 09/29/15
994 A RRN2 4S 0H 09/29/15
996 A R FKEY2 09/29/15
997 A 23 5'<F3>=Exit' 09/29/15
998 A COLOR(BLU) 09/29/15
999 A 22 2'__________________________________- 09/29/15
1000 A ___________________________________- 09/29/15
1001 A _________' 09/29/15
1002 A COLOR(BLU) 09/29/15
1003 A 23 20'<F12>=Cancel' 09/29/15
1004 A COLOR(BLU) 09/29/15
1005 A 09/29/15
1013 A R FKEY1 09/29/15
1014 A*%%TS SD 20150929 060325 USERNAME REL-V7R1M0 5770-WDS 09/29/15
1015 A 23 5'<F3>=Exit' 09/29/15
1020 A COLOR(BLU) 09/29/15
1030 A 22 2'__________________________________- 09/29/15
1040 A ___________________________________- 09/29/15
1050 A _________' 09/29/15
1060 A COLOR(BLU) 09/29/15
1070 A 23 18'<F6>=Add Collection' 09/29/15
1080 A COLOR(BLU) 09/29/15
1090 A 23 41'<F12>=Cancel' 09/29/15
1100 A COLOR(BLU) 09/29/15
* * * * E N D O F S O U R C E * * * *
RPGLE File:
5761WDS V7R1M0 100416 SEU SOURCE LISTING 09/30/15 07:13:46 SYSSERIAL PAGE 1
SOURCE FILE . . . . . . . GDRDEV/PBCSRC
MEMBER . . . . . . . . . PBCRPG
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
100 FPBCDSPF CF E WORKSTN 09/24/15
101 F SFILE(SUB1:RRN1) 09/24/15
102 F SFILE(WINDOW1:RRN2) 09/30/15
103 F Infds(Info) 09/24/15
200 FPBCLPF UF A E K DISK 09/29/15
201 09/29/15
202 09/24/15
203 DInfo DS 09/24/15
204 D CFKey 369 369 09/24/15
300 09/24/15
302 DExit C Const(X'33') 09/29/15
303 DEnter C Const(X'F1') 09/29/15
304 DAddCol C Const(X'36') 09/29/15
305 DRollup C Const(X'F5') 09/24/15
307 DSflpag C Const(14) 09/24/15
308 DCancel C Const(X'3C') 09/29/15
309 DDelete C Const('4') 09/29/15
310 09/24/15
600 DLstrrn S 4 0 Inz(0) 09/24/15
601 Dlstrrn2 S 4 0 Inz(0) 09/29/15
602 DNew_id S LIKE(ColID) 09/29/15
603 Di S 4 0 Inz(0) 09/24/15
604 09/24/15
700 /FREE 09/24/15
701 // Main Routine 09/24/15
702 Exsr Clear_Sub1; 09/24/15
800 Exsr Build_Sub1; 09/24/15
803 09/24/15
900 Dou *Inkc; 09/24/15
1300 Write Fkey1; 09/24/15
1301 Exfmt Sflctl; 09/30/15
1302 09/24/15
1303 // Select Statement 09/24/15
1304 Select; 09/24/15
1309 09/24/15
1310 // Key selection 09/29/15
1311 09/29/15
1314 //Pagedown is pressed 09/29/15
1315 When (CFKey = Rollup) and (not *In90); 09/30/15
1316 Exsr Build_Sub1; 09/28/15
1317 09/24/15
1318 //F12 is pressed 09/24/15
1319 When CFKey = Cancel; 09/24/15
1320 Leave; 09/24/15
1321 09/29/15
1326 //F6 is pressed 09/29/15
1327 When CFKey = AddCol; 09/29/15
1328 Exsr Add_Col; 09/29/15
1329 Setll (*Loval) PBCLPF; 09/29/15
1330 Exsr Clear_Sub1; 09/29/15
1331 Exsr Build_Sub1; 09/29/15
1335 09/29/15
1336 //Option Selection 09/29/15
1337 When CFKey = Enter; 09/29/15
1338 Exsr Process_Options; 09/29/15
1339 09/29/15
1340 Endsl; 09/24/15
1341 09/24/15
1400 Enddo; 09/24/15
1401 09/24/15
1402 *Inlr = *On; 09/24/15
1403 09/24/15
1404 // Sub Routines 09/24/15
1405 Begsr Clear_Sub1; 09/24/15
1406 Rrn1 = *Zero; 09/24/15
1407 Lstrrn = *Zero; 09/24/15
1408 *In31 = *On; 09/24/15
1409 Write Sflctl; 09/24/15
1410 *In31 = *Off; 09/24/15
1411 *In32 = *Off; 09/24/15
1412 *In90 = *Off; 09/24/15
1413 Endsr; 09/24/15
1414 09/24/15
1415 Begsr Build_Sub1; 09/24/15
1416 Rrn1 = Lstrrn; 09/24/15
1422 09/24/15
1423 For i = 1 to sflpag; 09/24/15
1424 Read PBCLPF; 09/25/15
1425 09/24/15
1426 If %eof; 09/30/15
1427 *In90 = *On; 09/24/15
1428 Leave; 09/24/15
1429 EndIf; 09/24/15
1430 09/24/15
1431 Rrn1 = Rrn1 + 1; 09/24/15
1432 Option = *Blank; 09/24/15
1433 Write Sub1; 09/24/15
1434 Endfor; 09/24/15
1435 09/24/15
1436 If Rrn1 = *Zero; 09/24/15
1437 *In32 = *On; 09/24/15
1438 EndIf; 09/24/15
1439 09/24/15
1440 Lstrrn = Rrn1; 09/24/15
1441 Endsr; 09/24/15
1442 09/29/15
1443 BEGSR Add_Col; 09/29/15
1444 Setgt (*Hival) PBCLPF; 09/29/15
1445 Readp PBCLPF; 09/29/15
1446 09/29/15
1447 If Not %EOF; 09/29/15
1448 New_ID = COLID + 1; 09/29/15
1449 ELSE; 09/29/15
1450 New_id = 1; 09/29/15
1451 Endif; 09/29/15
1452 09/29/15
1453 Clear COLFMT; 09/29/15
1454 COLID = New_id; 09/29/15
1455 Exfmt New_Col; 09/30/15
1456 09/29/15
1457 If (CfKey<>Exit) and (CfKey <> Cancel); 09/29/15
1458 Write COLFMT; 09/29/15
1459 EndIf; 09/29/15
1460 Endsr; 09/29/15
1461 09/29/15
1462 Begsr Delete_Record; 09/29/15
1463 For i = 1 to Lstrrn2; 09/29/15
1464 Delete (ColID) COLFMT; 09/29/15
1465 Endfor; 09/29/15
1471 Endsr; 09/29/15
1496 09/29/15
1497 Begsr Process_Options; 09/29/15
1498 09/29/15
1499 Exsr Clear_Sub2; 09/29/15
1500 Readc Sub1; 09/29/15
1501 Dow Not %eof; 09/29/15
1502 Select; 09/29/15
1503 When Option = Delete; 09/29/15
1504 Rrn2 = Rrn2 + 1; 09/29/15
1505 Write Window1; 09/29/15
1506 *In74 = *On; 09/29/15
1507 Update Sub1; 09/29/15
1508 *In74 = *Off; 09/29/15
1509 Endsl; 09/29/15
1510 Readc Sub1; 09/29/15
1511 EndDo; 09/29/15
1512 09/29/15
1513 If Rrn2 > 0; 09/29/15
1514 Lstrrn2 = Rrn2; 09/29/15
1515 Rrn2 = 1; 09/29/15
1516 Write FKey2; 09/29/15
1517 Exfmt Sf2Ctl; 09/29/15
1518 If (CFKey <> Exit) and (CFKey <> Cancel); 09/29/15
1519 Exsr Delete_Record; 09/29/15
1520 Setll (ColID) PBCLPF; 09/30/15
1521 Exsr Clear_Sub1; 09/29/15
1522 Exsr Build_Sub1; 09/29/15
1523 EndIf; 09/29/15
1524 EndIf; 09/29/15
1525 Endsr; 09/29/15
1526 09/29/15
1527 Begsr Clear_Sub2; 09/29/15
1528 Rrn2 = *Zero; 09/29/15
1529 Lstrrn2 = *Zero; 09/29/15
1530 *In41 = *On; 09/29/15
1531 Write Sf2ctl; 09/29/15
1532 *In41 = *Off; 09/29/15
1533 Endsr; 09/29/15
1534 09/29/15
1535 /END-FREE 09/24/15
* * * * E N D O F S O U R C E * * * *
Comment