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