FiveTech Software tech support forums

Code: Select all

DEFINE DIALOG dlgPATIENT TITLE sTitle SIZE 950, 650
@   3,  1 SAY "Key"         OF dlgPATIENT SIZE 90, 25  
// rest of definition
   @ 60, 51 BUTTON btnQUIT PROMPT "Quit" ACTION ( ::cExitCode := "Q", dlgPATIENT:End() ) OF dlgPATIENT 
ACTIVATE DIALOG dlgPATIENT CENTERED 

Code: Select all

ACTIVATE DIALOG dlgPATIENT CENTERED 

Code: Select all

/******************************************************************************
 *                                                                            *
 * xDATAFILE Class                                                            *
 *                                                                            *
 * This class encapsulates the functionality of xBase data files              *
 *                                                                            *
 ******************************************************************************/

CLASS xDATAFILE



DATA WorkArea

DATA KeyRecord

DATA Alias

DATA FileName

DATA MsgName

DATA Index1

DATA Index2

DATA Index3

DATA iNumIndx

DATA bSuccess

DATA sMessage

DATA iKey

DATA sKey

DATA iNumIndx
DATA lConsole
DATA lQuit
DATA lShared



METHOD New( WorkArea, KeyRecord, Alias, FileName, MsgName, Index1, Index2, Index3 ) CONSTRUCTOR

METHOD OpenRaw()

METHOD OpenIndexed()

METHOD OpenFile()

METHOD SetIndices()

METHOD Select()

METHOD LockFile()

METHOD LockRecord()

METHOD Unlock()

METHOD Close()

METHOD GoTo( RecNum )

METHOD GoTop()

METHOD GoBottom()

METHOD AppendBlank()

METHOD BOF()

METHOD EOF()

METHOD GetKey()

METHOD RptKey()

METHOD SetKey( xValue )

METHOD KeyValue()

METHOD Seek( Value )

METHOD SetOrder( Index )

METHOD RecCount()

METHOD Save( CallObj )

METHOD FileInfo()

METHOD Skip( SkipCount )

METHOD LastUpdated()



ENDCLASS



METHOD New( iWorkArea, iKeyRecord, sAlias, sFileName, sMsgName, lConsole, lQuit, Index1, Index2, Index3 ) CLASS xDATAFILE


::lConsole  := lConsole
::lQuit     := lQuit

::WorkArea  := iWorkArea

::KeyRecord := iKeyRecord

::Alias     := sAlias

::FileName  := sFileName

::MsgName   := sMsgName
::lShared   := .T.

::iNumIndx  := PCOUNT() - 7

IF ::iNumIndx < 0

   ::iNumIndx := 0

ENDIF

IF ::iNumIndx > 0

   ::Index1    := Index1

   IF ::iNumIndx > 1

      ::Index2 := Index2

      IF ::iNumIndx > 2

         ::Index3 := Index3

      ENDIF

   ENDIF

ENDIF



RETURN self



METHOD OpenRaw() CLASS xDATAFILE

   LOCAL lbRet

   SELECT ( ::WorkArea )

   lbRet := ::OpenFile()



RETURN lbRet





METHOD OpenIndexed() CLASS xDATAFILE



SELECT ( ::WorkArea )

IF ::OpenFile()
   IF ::lConsole
      ? ::MsgName + " opened in work area " +ALLTRIM( STR( ::WorkArea ) )
   ENDIF

   ::SetIndices()

   RETURN .T.

ENDIF

IF ::lConsole
   ? "Error Opening " + ::sMsgName
ENDIF
IF ::lQuit
   QUIT
ENDIF

RETURN .F.







METHOD OpenFile() CLASS xDATAFILE


IF ::lShared

   USE ( ::FileName ) ALIAS ( ::Alias ) SHARED
  ELSE
   USE ( ::FileName ) ALIAS ( ::Alias ) SHARED
ENDIF

/* LOCAL lsFName

lsFName := ::FileName

OPEN  lsFName */

IF NETERR()

   ? "Error opening " + ::FileName

   RETURN .F.

ENDIF



RETURN .T.





METHOD SetIndices() CLASS xDATAFILE



DO CASE

   CASE ::iNumIndx = 1

      SET INDEX TO ( ::Index1 )
      ?? " Index set to " + ALLTRIM( ::Index1 )

   CASE ::iNumIndx = 2

      SET INDEX TO ( ::Index1 ), ( ::Index2 )
      ?? " Indexes set to " + ALLTRIM( ::Index1 ) + ", " + ALLTRIM( ::Index2 )

   CASE ::iNumIndx = 3

      SET INDEX TO ( ::Index1 ), ( ::Index2 ), ( ::Index3 )
      ?? " Indexes set to " + ALLTRIM( ::Index1 ) + ", " + ALLTRIM( ::Index2 ) + ", " + ALLTRIM( ::Index3 )

ENDCASE



RETURN .T.



METHOD Select

   

   SELECT ( ::WorkArea )



RETURN







METHOD Unlock() CLASS xDATAFILE



   SELECT ( ::WorkArea )

   UNLOCK



RETURN





/*

METHOD LockRecord() CLASS xDATAFILE



   SELECT ( ::WorkArea )



RETURN RLOCK()

*/


METHOD LockRecord() CLASS xDATAFILE

   LOCAL iNumTries
   LOCAL lIsLocked
   SELECT ( ::WorkArea )
   iNumTries := 1
   DO WHILE iNumTries < 6
      lIsLocked := RLOCK()
      IF lIsLocked
         RETURN .T.
      ENDIF
      INKEY(0.5)
      iNumTries += 1
   ENDDO
   MsgInfo( "Unable to lock " + ::FileName )
RETURN .F.






METHOD LockFile() CLASS xDATAFILE



   SELECT ( ::WorkArea )



RETURN FLOCK()







METHOD Close() CLASS xDATAFILE

  

   SELECT ( ::WorkArea )

   CLOSE



RETURN





METHOD AppendBlank() CLASS xDATAFILE



   SELECT ( ::WorkArea )

   APPEND BLANK



RETURN ( !NETERR() )







METHOD BOF() CLASS xDATAFILE



   SELECT ( ::WorkArea )



RETURN BOF()





METHOD EOF() CLASS xDATAFILE



   SELECT ( ::WorkArea )



RETURN EOF()





METHOD GetKey() CLASS xDATAFILE

   

   SELECT ( defWA_KEY )

   IF ::KeyRecord < 1

      RETURN .F.

   ENDIF

   IF ::KeyRecord > RECCOUNT()

      RETURN .F.

   ENDIF

   GOTO ( ::KeyRecord )

   ::iKey := KY_LASTKEY

   ::iKey += 1

   IF RLOCK()

      REPLACE KY_LASTKEY WITH ::iKey

      UNLOCK

      ::sKey := PADL( ALLTRIM( STR( ::iKey)), 16, "0" ) 

      RETURN .T.

   ENDIF

   

RETURN .F.



METHOD RptKey() CLASS xDATAFILE

   

   LOCAL liKey

   SELECT ( defWA_KEY )

   IF ::KeyRecord < 1

      RETURN 0

   ENDIF

   IF ::KeyRecord > RECCOUNT()

      RETURN 0

   ENDIF

   GOTO ( ::KeyRecord )

   liKey := KY_LASTKEY

   SELECT ( ::WorkArea )

RETURN ( liKey )



METHOD SetKey( xValue ) CLASS xDATAFILE

   ALERT( "SetKey" )

   SELECT ( defWA_KEY )

   IF ::KeyRecord < 1

      RETURN .F.

   ENDIF

   IF ::KeyRecord > RECCOUNT()

      RETURN .F.

   ENDIF

   // ALERT( TYPE( xValue ) )

   GOTO ( ::KeyRecord )

   IF RLOCK()

      REPLACE KY_LASTKEY WITH xValue

      UNLOCK

      ::iKey := xValue

      ::sKey := PADL( ALLTRIM( STR( ::iKey)), 16, "0" ) 

      RETURN .T.

   ENDIF

   

RETURN .F.





METHOD KeyValue() CLASS xDATAFILE



RETURN ::sKey





METHOD Seek( Value ) CLASS xDATAFILE

   LOCAL llFound



   SELECT ( ::WorkArea )



   SEEK  Value 

   llFound := FOUND()

   IF llFound

      // ALERT( "Found"  )

     ELSE

      // ALERT( "Not Found" )

   ENDIF   





RETURN llFound





METHOD SetOrder( Index ) CLASS xDATAFILE



   SELECT ( ::WorkArea )

   SET ORDER TO ( Index )



RETURN





METHOD RecCount() CLASS xDATAFILE

   

   SELECT ( ::WorkArea )

   

RETURN RECCOUNT()



METHOD Save( CallObj ) CLASS xDATAFILE

   

   LOCAL llSuccess



   SELECT ( ::WorkArea )

   CallObj:sLUBy := oUSER:sKey

   CallObj:sLUWhen := oDATETIME:Now()



   IF CallObj:lInsert 

      IF ::GetKey()

         CallObj:sKey := ::sKey      

         CallObj:cLUActn := "I"

         llSuccess := ::AppendBlank()
        ELSE
         ALERT("Failed to retrieve key")
      ENDIF

     ELSE

      CallObj:cLUActn := "U"

      llSuccess := ::LockRecord()

   ENDIF

   IF llSuccess

      CallObj:Write()
      dbCOMMIT()

      UNLOCK

   ENDIF

   

RETURN llSuccess





METHOD FileInfo() CLASS xDATAFILE

   

LOCAL lcRet

LOCAL lcLKey

   SELECT ( ::WorkArea )
   lcRet := PADR( ::FileName, 16 ) + " WA= " + LTRIM( STR( ::WorkArea ) ) + " has " + ;
      LTRIM( STR( RECCOUNT() ) ) + " records - updated " + DTOS( LUPDATE() ) + " last key " + STR( ::RptKey() )
/*

   lcRet := PADR( ::FileName, 16 ) + " WA= " + LTRIM( STR( ::WorkArea ) ) + " has " + ;

      LTRIM( STR( RECCOUNT() ) ) + " recs - updated " + DTOS( LUPDATE() ) + "last key " 

  IF EMPTY( ::RptKey() )

      lcLKey := "0"

     ELSE

      lcLKey := STR( ::RptKey() )

   ENDIF 

   lcRet += lcLKey

*/

RETURN lcRet 





METHOD Skip( SkipCount ) CLASS xDATAFILE

   

   LOCAL lnCount

   

   IF PCOUNT() < 1

      lnCount := 1

     ELSE

      lnCount := SkipCount

   ENDIF

   SELECT ( ::WorkArea )

   SKIP ( lnCount )

   

RETURN





METHOD GoTo( RecNum ) CLASS xDATAFILE

   

   SELECT ( ::WorkArea )

   GOTO RecNum

   

RETURN



METHOD GoTop() CLASS xDATAFILE

   

   SELECT ( ::WorkArea )

   GOTO TOP

   

RETURN





METHOD GoBottom() CLASS xDATAFILE

   

   SELECT ( ::WorkArea )

   GOTO BOTTOM

   

RETURN



METHOD LastUpdated() CLASS xDATAFILE

   

   SELECT ( ::WorkArea )

   RETURN DTOS( LUPDATE() )

   

RETURN nil