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:Visible:=.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:Document:Content
IF AT( cSrc, oRng:Text ) = 0
RETURN .F.
ENDIF
WHILE oRng:Find: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
