Tweet
Re: Deleting single record from subfile,how???
I cranked this out real quick, so there might be some dumb stuff inside:
Display File - SubFileD
Program - SubFile
I cranked this out real quick, so there might be some dumb stuff inside:
Display File - SubFileD
Code:
A*%%TS SD 20110310 104809 QPGMR REL-V6R1M0 5761-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A CF03(03)
A CF05(05)
A INDARA
A R SFLA SFL
A*%%TS SD 20110310 104809 QPGMR REL-V6R1M0 5761-WDS
A OPTION 1Y 0B 6 4COLOR(WHT)
A EDTCDE(Z)
A DAYNUMBER 1 0O 6 8
A DAYNAME 10 O 6 12
A R SFLB SFLCTL(SFLA)
A*%%TS SD 20110310 104809 QPGMR REL-V6R1M0 5761-WDS
A SFLSIZ(0010)
A SFLPAG(0009)
A N92 ROLLUP
A OVERLAY
A 90 SFLDSP
A SFLDSPCTL
A 91 SFLCLR
A 92 SFLEND(*MORE)
A PGRRN 4S 0H SFLRCDNBR
A 5 2'Opt'
A COLOR(PNK)
A DSPATR(UL)
A 1 22'Jamies Subfile Delete Program'
A COLOR(WHT)
A 5 6'Day#'
A COLOR(PNK)
A DSPATR(UL)
A 5 12'Day Name '
A COLOR(PNK)
A DSPATR(UL)
A 4 4'Option 4 - Delete'
A COLOR(WHT)
A R FOOTER
A*%%TS SD 20110310 102702 QPGMR REL-V6R1M0 5761-WDS
A 23 2'F3-Exit'
A COLOR(WHT)
A R ASSUME
A*%%TS SD 20100814 163357 QPGMR REL-V6R1M0 5761-WDS
A 1 3' '
Code:
**************************************************************************
*
* Program - S U B F I L E
* Jaime's Delete Subfile Record Program
*
* Copyright (c) 1996,2010 Michael Catalani
* 901.581.8791 cell phone
* 901.672.7572 home phone
*
* Description - Program shows how to delete a sngle subfile record
* using data structures
*
* Using option 4 next to an subfile record will
* cause it to be removed frmo the subfile
*
*************************************************************************
h DftActGrp( *No )
fSubfileD cf e Workstn
f SFILE( SflA : PgRRN )
f IndDS( DisplayDS )
*** Program Variables ***
d PgRRN s 4s 0
*** Display File Indicators Data Structure ***
d DisplayDS ds
d ExitKeyPressed...
d 3 3n
d DisplaySubfile...
d 90 90n
d DeleteSubfile 91 91n
d EndOfSubfile 92 92n
*** Program DataStructures ***
d SubfileDS ds LikeRec( SflA : *All )
*** ProtoTypes ***
d ClearSubFile pr
d DisplayScreen pr
d LoadSubFile pr
d SetSubFileStatus...
d pr
d RemoveDeletedSubfileRecords...
d pr
**********************************************
* Main Procedure
**********************************************
/free
LoadSubfile();
dow NOT ExitKeyPressed;
d ClearSubFile pr
d DisplayScreen pr
d LoadSubFile pr
d SetSubFileStatus...
d pr
d RemoveDeletedSubfileRecords...
d pr
**********************************************
* Main Procedure
**********************************************
/free
LoadSubfile();
dow NOT ExitKeyPressed;
when Option = 4;
// put delete code here
// for LoadIndex = 1 to PgRRN;
// SubFileSave( LoadIndex ) = SubfileDS;
// ClearSubfile;
// leave;
endsl;
Option = 0;
update SflA;
readc(e) SflA;
enddo;
write Footer;
exfmt SflB;
/end-free
p e
**********************************************
* ClearSubfile Subprocedure
**********************************************
p ClearSubFile b
d pi
/free
DeleteSubfile = *on;
write SflB;
DeleteSubfile = *off;
EndOfSubfile = *off;
PgRRN = 0;
/end-free
p e
**********************************************
* LoadSubfile SubProcedure
**********************************************
p LoadSubFile b
d pi
d ds
d Day 70a Inz('Monday +
d Tuesday +
d Wednesday +
d Thursday +
d Friday +
d Saturday +
d Sunday ')
d DayArray 10a overlay(Day) dim(7)
d DayNumber s 1s 0
/free
for PgRRN = 1 to 7;
SubFileDS.DayNumber = PgRRN;
SubFileDS.DayName = DayArray( PgRRN );
SubFileDS.Option = 0;
write SflA SubFileDS;
endfor;
SetSubfileStatus();
return;
/end-free
p e
**********************************************
* SetSubfileStatus Subprocedure
**********************************************
p SetSubfileStatus...
p b
d pi
/free
EndOfSubfile = *on;
if PgRRN > 0;
DisplaySubfile = *on;
PgRRN = 1;
else;
DisplaySubfile = *off;
endif;
return;
/end-free
p e
**********************************************
* RemoveDeletedSubfileRecords Subprocedure
**********************************************
p RemoveDeletedSubfileRecords...
p b
d pi
d SubFileSaveDS ds LikeDS( SubFileDS ) Dim( 9999 )
d SaveIndex s 10i 0
d Index s 10i 0
/free
SaveIndex = 1;
chain SaveIndex Sfla SubFileDS;
dow %found( SubfileD );
eval-corr SubFileSaveDS( SaveIndex ) = SubFileDS;
SaveIndex +=1;
chain SaveIndex Sfla SubFileDS;
enddo;
ClearSubfile();
for Index = 1 to SaveIndex - 1;
if SubFileSaveDS( Index ).Option <> 4;
PgRRN +=1;
write Sfla SubfileSaveDS( Index );
endif;
endfor;
SetSubfileStatus();
return;
/end-free
p e
) 
Comment