Liren Large Software Subsidy 5

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAAPPE.INC < prev next >

Wrap

Text File | 1988-06-03 | 7.2 KB | 294 lines

<<* MSAAPPE.INC *>> <<# function fixfldini : string string strg begin strg := fldini if fldtyp = 'C' if not (strg[1] $ '["'+"'") strg := '"' + strg + '"' endif elsif fldtyp = 'L' if strg[1] <> '.' strg := '.' + strg + '.' endif endif RETURN strg end fixfldini procedure GenInitFlds begin select all genln( '* ---Initialize fields/memvars.' ) if not ismultials select database 1 select fields on fldini and (fldtyp $ 'CDLN') if fldtotal > 0 forall fields genln( 'STORE ',fixfldini,' TO ',fixfldnam ) endfor else genln( '* ---<none>.' ) endif else genln( 'DO CASE' ) forall databases filespec( dbfnam,fpath,fname,fext ) genln( 'CASE dbfarea = "',dbfcount,'"' ) pushmargin( 1 ) select fields on fldini and (fldtyp $ 'CDLN') if fldtotal > 0 forall fields genln( 'STORE ',fixfldini,' TO ',fixfldnam ) endfor else genln( '* ---<none>.' ) endif popmargin endfor genln( 'ENDCASE' ) endif end GenInitFlds #>> <<procedure AppendPages>> <<begin>> * ---Edit and page through the record. * ---The following loop is really a "REPEAT/UNTIL <cond>". DO WHILE .T. DO StatLine WITH LastRec+recnumOFS,IsDeleted @ 0,50 SAY "*BLANK* " <<GenColor( 2,'SCREEN' )>> @ 24,0 CLEAR @ 24,0 SAY 'Enter Record...' DO {fileprefix}_GETS <<if ismultials>> DO Page WITH pageno,1,dbfpagemax <<else>> DO Page WITH pageno,1,PageMax <<endif>> * ---Condition to exit inner loop. IF pageno = 1 EXIT ENDIF DO {fileprefix}_FORM ENDDO <<if ismultials>> pageno = dbfpagemax <<endif>> <<end AppendPages>> <<procedure GenUniqueOne>> <<* Assumes one or more indexes *>> <<begin>> * ---Check for duplicate record. DO WHILE .T. <<GenColor( 2,'SCREEN' )>> @ 24,0 CLEAR @ 24,0 SAY 'Enter Record...' * ---Enter key field values. DO {fileprefix}_KEYS WITH expr,IsBlank,IsUnique IF IsBlank .OR. .NOT. IsUnique EXIT ENDIF * ---Check for duplicate key in master file. SEEK expr IF EOF() * ---No duplicate key found, so leave. EXIT ELSE * ---Found a duplicate record in the file. <<GenColor( 2,'STATUS' )>> @ 0,50 SAY "*DELETED*" DO SayLine WITH row,; "DUPLICATE KEY encountered. Record cannot be appended." WAIT ENDIF ENDDO <<end GenUniqueOne>> <<# procedure AppendWithEdit logical iswithndx begin iswithndx := false select all forall databases if ndxtotal > 0 iswithndx := true endif endfor #>> <<if iswithndx>> <<GenUniqueOne>> <<else>> * ---Enter key field values. <<GenColor( 2,'SCREEN' )>> @ 24,0 CLEAR @ 24,0 SAY 'Enter Record...' DO {fileprefix}_KEYS WITH expr,IsBlank,IsUnique <<endif>> IF IsBlank IsDeleted = .T. ELSE <<if ismultipage>> <<pushmargin( 1 )>> <<AppendPages>> <<popmargin>> <<else>> DO {fileprefix}_GETS <<endif>> ENDIF <<end AppendWithEdit>> <<procedure GenAppendBody>> <<string line>> <<begin>> PRIVATE row,recnum,recnumOFS PRIVATE IsBlank,IsUnique,IsCarry,IsDeleted,IsEdited <<if ismultials>> <<GenPrivateFlds( 0 )>> <<endif>> * ---Initialize local memory variables. row = PromptRow recnumOFS = 0 STORE .F. TO IsBlank,IsUnique,IsCarry,IsDeleted,IsEdited expr = "" <<if not ismultipage>> DO {fileprefix}_FORM <<endif>> * ---Start by adding one record. choice = Returnkey * ---The following loop is really a "REPEAT/UNTIL <cond>". DO WHILE .T. <<if ismultials and ismultipage>> * ---Start database file on correct page. DO CASE <<forall databases>> CASE dbfarea = {"}{dbfcount}{"} <<select field 1>> pageno = {fldpag} <<endfor>> ENDCASE <<endif>> <<if ismultipage>> DO {fileprefix}_FORM <<endif>> IF (choice = Returnkey) .OR. IsCarry * ---Add another record. recnumOFS = recnumOFS + 1 IF .NOT. IsCarry * ---Initialize memory variables with blanks. GOTO BOTTOM IF .NOT. EOF() SKIP ENDIF DO {fileprefix}_SAYS DO {fileprefix}_STOR GOTO BOTTOM <<pushmargin( 3 )>> <<GenInitFlds>> <<popmargin>> ENDIF IsCarry = .F. ENDIF DO StatLine WITH LastRec+recnumOFS,IsDeleted @ 0,50 SAY "*BLANK* " <<# pushmargin( 1 ) AppendWithEdit popmargin #>> DO StatLine WITH LastRec+recnumOFS,IsDeleted * ---Loop until Add, Carry, Edit, or Finished is selected. * ---The following loop is really a "REPEAT/UNTIL <cond>". menuchoice = 4 DO WHILE .T. * ---You can add other prompts and options in this inner loop. * ---For example, to add an invoicing routine: * * (1) Insert "{I}nvoice" in the prompt line below, * (2) Include "I" in the values for GetKey, and * (3) Add a CASE to the DO CASE structure, such as: * * CASE choice = "I" * DO <invoice_program_name> * <<* 1 2 3 4 5 6 0123456789012345678901234567890123456789012345678901234567890123 APPEND: Add-another Carry-add Edit Finished <Del> " APPEND: Add-another Carry-add Edit Finished Output <Del> " *>> SAVE SCREEN TO APPENDSCR <<GenColor(0,'SCREEN')>> @ 22,0 CLEAR menuchoice = 0 <<if feat(featlabel)>> MSG1 = "Add-another" MSG2 = "Carry-add" MSG3 = "Edit" MSG4 = "Delete" MSG5 = "Output" MSG6 = "Return" DO {fileprefix}_MENU WITH 1,60,6,13 choice =SUBSTR( "F"+Returnkey+"CE"+DelRecord+"OF",menuchoice + 1,1 ) <<else>> MSG1 = "Add-another" MSG2 = "Carry-add" MSG3 = "Edit" MSG4 = "Delete" MSG5 = "Return" DO {fileprefix}_MENU WITH 1,60,5,13 choice =SUBSTR( "F"+Returnkey+"CE"+DelRecord+"F",menuchoice + 1,1 ) <<endif>> RESTORE SCREEN FROM APPENDSCR DO CASE CASE choice = DelRecord * ---Toggle IsDeleted flag. IsDeleted = .NOT. IsDeleted DO StatLine WITH LastRec+recnumOFS,IsDeleted CASE choice = "E" * ---Re-edit the record. IsDeleted = .F. CASE choice $ "CF"+Returnkey * ---Finished, Add-another, or Carry-add. IsCarry = (choice = "C") IF IsDeleted * ---Reset offset so as not to increment. recnumOFS = recnumOFS - 1 ELSE * ---Save the memvar values. APPEND BLANK DO {fileprefix}_REPL ENDIF <<if feat(featlabel)>> CASE choice = "O" * ---Print one label/record. <<pushmargin( 3 )>> <<GenOutputItems>> <<popmargin>> choice = "O" <<endif>> ENDCASE * ---Condition to exit inner loop. IF choice $ "CEF"+Returnkey EXIT ENDIF ENDDO * ---Condition to exit outer loop. IF choice = "F" EXIT ENDIF ENDDO LastRec = LastRec + recnumOFS GOTO TOP <<end>> <<*GenAppendBody*>> <<* EOF: MSAAPPE.INC *>>