FiveTech Support Forums

Function Genera_Examen_Altura(nFicha,cTAte,dfec,cNom,cRut,nEdad,cNaci,cOtos,cVis,cPes,cAlt,cPart,cPul,cFres,cEle,cGli,cEva,cHem,cUre,cOri)
   Local oWord, oSel, oDoc,cOrigen,cDestino,cFile,cSave, Nom1,rut1,naci1,cFilep,cSavep,cDestinop
   local oActiveDoc,aArrReplace, n

     IF MsgYesNo( "Desea Generar ARCHIVOS EXAMENES ALTURA / PRE-OCU ?","Ingrese Opción")
                Do Case
                        Case Tip_Ate1=="A"
                                If (Empty(cNom).or.Empty(cRut).or.Empty(nEdad).or.Empty(cNaci).or.Empty(cOtos).or.Empty(cVis).or.Empty(cPes) .or. Empty(cAlt).or. Empty(cPart) .or. Empty(cPul).or.Empty(cFres).or.Empty(cEva).or.Empty(cEle).or.Empty(cGli))

                                     Tone(3000)
                                     MsgInfo("Revise, Faltan Relacionados a Examen de Altura")
                                     Return .F.
                                Endif
                                MsgInfo( "Atención: "  + CRLF +;
                                            "En estos momentos Ud.Generará e Imprimirá" + CRLF +;
                                            "Un Informe de Examen de Altura, por lo que" + CRLF +;
                                            "Esperar hasta que se muestre un aviso con" + CRLF +;
                                                    "El Nombre del Informe Generado, en ese momento"  + CRLF +;
                                            "El Proceso habra terminado.")

                        Case Tip_Ate1=="P"
                                If (Empty(cNom).or.Empty(cRut).or.Empty(nEdad).or.Empty(cNaci).or.Empty(cOtos).or.Empty(cVis).or.Empty(cPes);
                                .or. Empty(cAlt).or. Empty(cPart) .or. Empty(cPul).or.Empty(cFres).or.Empty(cEva).or.Empty(cEle).or.Empty(cGli).or. Empty(cHem).or.Empty(cUre).or.Empty(cOri))


                                     Tone(3000)
                                     MsgInfo("Revise, Faltan Datos Relacionados a Examen de Altura o Pre-Ocupacional")
                                     Return .F.
                                Endif
                                MsgInfo( "Atención: "  + CRLF +;
                                            "En estos momentos Ud.Generará e Imprimirá" + CRLF +;
                                            "Un Informe de Examen de Altura y un Pre-Ocupacional" + CRLF +;
                                            "Esperar hasta que se muestre 2 avisos con El Nombre" + CRLF +;
                                                    "de los Informes Generados, en ese momento El Proceso"  + CRLF +;
                                            "habra terminado.")

                 EndCase

                cNom:= AnsiToOem(cNom)

                nEva:= aScan(aEvaMed,   { | array | array[1] == cEva} )
                cEva=aEvaMed[nEva ][2]   //  <--- Obtener Nombre del dato del arreglo

                cEle:= AnsiToOem(cEle)
                cGli:= AnsiToOem(cGli)
                cOrigen  :=  hb_CurDrive()+":\"+curdir()+"\Examenes\Doc_Bases\"
            cDestinoa := hb_CurDrive()+":\"+curdir()+"\Examenes\Altura\"
            cDestinop := hb_CurDrive()+":\"+curdir()+"\Examenes\Pre-Ocu\"

            cFile := "AlturaBase.docx"
            cSave := "Altura-"+alltrim(Str(nFicha,10))+"-"+cNom+".doc"

                cFilep := "PreocuBase.docx"
            cSavep := "Pre-"+alltrim(Str(nFicha,10))+"-"+cNom+".doc"

                If lDocAbierto(cOrigen + cFile)      //variable que contiene path , nombre, y ext. del fichero modelo o plantilla
                    MsgStop("Documento " + cFile + " está abierto.","Alto")
                    Return .f.
            endif
                */

            TRY
                 oWord := win_oleCreateObject( "Word.Application")

             CATCH
                 MsgInfo("Word no está instalado en esta PC. No se puede continuar")
                 Return NIL
             END

             TRY
                 oDoc := oWord:Documents:Open(cOrigen + cFile)
             CATCH
                 MsgInfo("No se puede abrir el archivo plantilla " + cOrigen + cFile)
                 oWord:Quit()
                 Return NIL
             END
             oDoc:Select()
             oSel = oWord:Selection
             aArrReplace := { { "[nombrepaciente]", AllTrim(cNom) } ,;
                              { "[rut]"           , AllTrim(cRut) } ,;
                              { "[edad]"          , AllTrim(Str(nEdad,3)) } ,;
                                                     { "[naciona]"       , AllTrim(cNaci) },;
                                                     { "[otos]"          , AllTrim(cOtos) },;
                                                     { "[visi]"          , AllTrim(cVis) },;
                                                     { "[pes]"               , AllTrim(cPes) },;
                                                     { "[alt]"               , AllTrim(cAlt) },;
                                                     { "[par]"               , AllTrim(cPart) },;
                                                     { "[pul]"               , AllTrim(cPul) },;
                                                     { "[fr]"                , AllTrim(cFres) },;
                                                     { "[eva]"               , AllTrim(cEva) },;
                                                     { "[ekg]"               , AllTrim(cEle) },;
                                                     { "[gli]"               , AllTrim(cGli) },;
                                                     { "[fate]"          , Dtoc(dfec) } }

             For n:=1 to Len(aArrReplace)
                 Reemplaza_Text_F2( oSel, aArrReplace[n][1], aArrReplace[n][2] )
             Next n

                oWord:ActiveDocument:SaveAs(cDestinoa + cSave)
         //     oWord:ActiveDocument:PrintOut()     // Habilitar Imprime Dcoumento
            oWord:ActiveDocument:Close()




             SysRefresh()
                    MsgInfo(" Examen de Altura Generado "+cSave)
                    ** Si Existe Pre-Ocupacional
                    If cTAte = "P"

                                If lDocAbierto(cOrigen + cFilep )      //variable que contiene path , nombre, y ext. del fichero modelo o plantilla
                                    MsgStop("Documento " + cFilep + " está abierto.","Alto")
                                    Return .f.
                            endif

                          TRY
                                 oWord := win_oleCreateObject( "Word.Application")

                          CATCH
                                 MsgInfo("Word no está instalado en esta PC. No se puede continuar")
                                 Return NIL
                            END

                        TRY
                            oDoc := oWord:Documents:Open(cOrigen + cFilep )
                        CATCH
                            MsgInfo("No se puede abrir el archivo plantilla " + cOrigen + cFilep)
                            oWord:Quit()
                            Return NIL
                        END

                     *  oWord:=.T.   // Para Mostrar

                        oDoc:Select()
                        oSel = oWord:Selection
                        // Crear Matriz de reemplazos
                        aArrReplace := { { "[nombrepaciente]", AllTrim(cNom) } ,;
                                         { "[rut]"           , AllTrim(cRut) } ,;
                                         { "[edad]"          , AllTrim(Str(nEdad,3)) } ,;
                                                                 { "[naciona]"       , AllTrim(cNaci) },;
                                                                 { "[pes]"               , AllTrim(cPes) },;
                                                                 { "[alt]"               , AllTrim(cAlt) },;
                                                                 { "[par]"               , AllTrim(cPart) },;
                                                                 { "[ekg]"               , AllTrim(cEle) },;
                                                                 { "[eva]"               , AllTrim(cEva) },;
                                                                 { "[gli]"               , AllTrim(cGli) },;
                                                                 { "[hem]"               , AllTrim(cHem) },;
                                                                 { "[ure]"               , AllTrim(cUre) },;
                                                                 { "[ori]"               , AllTrim(cOri) },;
                                                                 { "[fate]"          , Dtoc(dfec) } }

                            For n:=1 to Len(aArrReplace)
                                Reemplaza_Text_F2( oSel, aArrReplace[n][1], aArrReplace[n][2] )
                            Next n

                                oWord:ActiveDocument:SaveAs(cDestinop + cSavep)
                        //  oWord:ActiveDocument:PrintOut()     // Habilitar Para Imprimir
                            oWord:ActiveDocument:Close()



                            SysRefresh()

                                    MsgInfo(" Examen de Pre-Ocupacional Generado "+cSavep)

                    Endif
                    ** Fin Pre-Ocupa
         Endif
Return nil

//---------------------------------------------------//
Static Function Reemplaza_Text_F2( oSel, cSrc, cRpl)
    Local wdCollapseEnd:=0
    LOCAL oRng := oSel:Content

    IF AT( cSrc, oRng:Text ) = 0
        RETURN .F.
    ENDIF

    WHILE oRng:Execute( cSrc )
        oRng:Text = cRpl
        oRng:Collapse( wdCollapseEnd )
    ENDDO

RETURN .T.



// Para Consultar si Archivo Plantilla esta Abierto
Function lDocAbierto(cDocName)
        Local FO_EXCLUSIVE := 16
        local lOpen:=.f., nHand
          If ( nHand := FOPEN(cDocName, FO_EXCLUSIVE ) ) = -1
             lOpen := .t.
          Else
             FCLOSE( nHand )
          Endif
        Return lOpen

#include "FiveWin.ch"

function Main()
LOCAL oDlg

   DEFINE DIALOG oDlg TITLE "This is a dialog" SIZE 400, 200
   @ 4,  8 BUTTON "Ok" ACTION Merge("C:\FWH\samples\base.rtf","C:\FWH\samples\QR.bmp") 
   ACTIVATE DIALOG oDlg CENTERED 

return nil


*************************************************
** Armar documento rtf
*************************************************
PROCEDURE Merge(cBase,cImg)
LOCAL oWord , oDoc, cText , cDoc , cImgBase64 

cDoc := cBase
cImgBase64 :=  StrToHex(hb_memoread( cImg ) ) 
cText := MEMOREAD(cDoc)
cText := STRTRAN(ctext,"//IMAGEN//",'{\pict\pngblip\picw1000\pich1000\picwgoal1000\pichgoal1000\bin '+cImgBase64+' }')

   if !GrabaArchivo( 'c:\fwh\samples\antonio_nuevo.rtf', cText )
      MsgAlert("Fallo crear documento, verifique que no este en uso" , "Alerta"  )           
      RETURN
   ENDIF
   if   (oWord := WinWordObj() ) == nil
        MsgAlert( "MS Word no instalado" ,  "Alerta" )        
        else
        oDoc = oWord:Documents:Open('c:\fwh21\samples\antonio_nuevo.rtf')
        if oDoc == nil
           MsgAlert("Fallo crear documento, verifique que no este en uso" , "Alerta"  )           
         endif
   endif   
   oDoc:Application:Visible := .t.
RETURN

*****************
** Grabar archivo
FUNCTION GrabaArchivo(cArchivo,cDato)
LOCAL Han, nBytes, nErr
Han := FCreate(cArchivo)
nBytes := FWRITE(Han,cDato,Len(cDato))
nErr := Ferror()
IF nErr <> 0 
   MsgStop("Error " + STR(nErr)+CHR(10)+cArchivo,"Error")
ENDIF
LCLOSE(Han)
RETURN nBytes = Len(cDato)

function Imprimir()

   local oPrn, cRtf
   cRtf  := MEMOREAD( "MiRtfBase.rtf" )
   //Aca deberías reemplazar el texto variable del rtf

   PRINT oPrn PREVIEW   

   PAGE
      
      @ 1, 1 PRINT TO oPrn TEXT cRtf  SIZE 19,18 CM
      
      @ 19,01 PRINT TO oPrn IMAGE "firma.jpg"  CM
      @ 19,15 PRINT TO oPrn IMAGE "qr.bmp"  CM

   ENDPAGE
   ENDPRINT

return nil