Разработка программной системы для автоматизации информационного обмена между страховыми медицинскими организациями

ENDIF

SELECT tmp2

SCAN ALL

IF SEEK(tmp2.ReplyID, 'Reply', 'ReplyID')

Продолжение приложения 1

IF ALLTRIM(tmp2.numq) == 'Q01'

replace ein WITH "" IN Tmp2

ENDIF

IF ALLTRIM(tmp2.numq) == 'Q03'

replace ein WITH "",;

remstat WITH 0 IN Tmp2

ENDIF

IF ALLTRIM(tmp2.numq) == 'Q04'

replace ein WITH Reply.ein IN Tmp2

ENDIF

IF ALLTRIM(tmp2.numq) == 'Q08'

replace ein WITH Reply.ein,;

remstat WITH 3 IN Tmp2

ENDIF

IF ALLTRIM(tmp2.numq) == 'Q09'

replace ein WITH Reply.ein,;

remstat WITH Reply.remstat IN Tmp2

ENDIF

ENDIF

ENDSCAN

USE IN Reply

RETURN 'tmp2'

ENDFUNC

Процедура запаковки и отправки пакета

На входе - Алиас, полное имя пакета

На выходе - результат работы архиватора

FUNCTION fncPack

LPARAMETERS lcAlias as String, lcNamePak as String

LOCAL lcTemplate as String, lnReturn as Integer

lcTemplate = fncGetTemplate(gnIDTypeIn)

IF !USED(lcTemplate)

USE (gcTemplatePath + lcTemplate) IN 0 ALIAS &lcTemplate

ENDIF

SET STEP ON

SET TALK OFF

ZAP IN &lcTemplate

SET TALK ON

SELECT &lcTemplate

APPEND FROM DBF(lcAlias)

USE IN &lcTemplate

COPY FILE (gcTemplatePath + ALLTRIM(lcTemplate)+'.dbf') TO (gcArxPath + ALLTRIM(lcTemplate)+'.dbf')

lnReturn=RunProcess(gcArxPath+"pack.bat"+" "+gcOutPutPath + ALLTRIM(lcNamePak) + " " + ALLTRIM(lcTemplate)+ ".dbf",gcArxPath)

* (0 - если Ошибка, 1- все в норме)

DELETE FILE (gcArxPath + ALLTRIM(lcTemplate)+'.dbf')

RETURN lnReturn

ENDFUNC

Функция определения имени таблицы пакета

На входе - Id Типа пакета

На выходе - Имя шаблона

FUNCTION fncGetTemplate

LPARAMETERS lnIdType as Integer

LOCAL lcTemplate as String

IF !USED('TypePackets')

USE (gcDataPath + "TypePackets.dbf") IN 0 ALIAS TypePackets

ENDIF

SELECT TypePackets

LOCATE FOR TypePackets.TypeId = lnIdType

IF FOUND()

lcTemplate = TypePackets.Template

ENDIF

USE IN TypePackets

RETURN lcTemplate

ENDFUNC

Функция регистрации пакета в журнале и отметка о статистике по запросам

На входе - Id Типа пакета, полное имя пакета, алиас таблицы

На выходе - Id Пакета

FUNCTION fncGetRegPacket

LPARAMETERS lnNamePak as String, lnType as Integer, lcAlias as String

LOCAL lnId

IF !USED('Packety')

USE (gcDataPath + "Packety.dbf") IN 0 ALIAS Packety

ENDIF

INSERT INTO Packety (Name, TypeID) VALUES (lnNamePak, lnType)

GO BOTTOM in Packety

lnId = Packety.PacketId

USE IN Packety

IF !USED('Queryes')

USE (gcDataPath + "Queryes.dbf") IN 0 ALIAS Queryes

ENDIF

SELECT lnId as packetid, numq, COUNT(*) FROM &lcAlias GROUP BY 1,2 INTO CURSOR cur

INSERT INTO queryes (PacketId, Numq, AmountNumq) SELECT * FROM cur

USE IN cur

USE IN Queryes

RETURN lnId

ENDFUNC

Функция генерации имени пакета

На входе - нет ничего

На выходе - полное имя пакета

FUNCTION fncGetNamePak

LPARAMETERS lnNum as Integer, lcYMD as String

LOCAL lcType as String

lcType = fncGetTypePacket(gnIDTypeIn)

RETURN PADL(gcSMO,5,"0") + ALLTRIM(lcType) + ALLTRIM(STR(lnNum)) + "." + ALLTRIM(lcYMD)

ENDFUNC

Функция определения типа исходящего пакета

Входной параметр - Id Типа

На выходе - тип

FUNCTION fncGetTypePacket

LPARAMETERS lnId as Integer

LOCAL lcType as String

lcType = ""

IF !USED('TypePackets')

USE (gcDataPath + "TypePackets.dbf") IN 0 ALIAS TypePackets

ENDIF

SELECT TypePackets

LOCATE FOR TypePackets.TypeId = lnId

IF FOUND()

lcType = TypePackets.Type

ENDIF

USE IN TypePackets

RETURN lcType

ENDFUNC

Функция перевода даты в формат ГМД

На входе - дата

На выходе - ГМД

FUNCTION fncDateToYMD

LPARAMETERS ldDate as Date

LOCAL ldYear,;

ldMonth,;

ldDay as Integer,;

lcYMD as String

SET DECIMALS TO 0

ldYear = VAL(RIGHT(STR(YEAR(DATE())),2))

ldMonth = MONTH(ldDate)

ldDay = DAY(ldDate)

lcYMD = fncSystem32(ldYear) + fncSystem32(ldMonth) + fncSystem32(ldDay)

RETURN lcYMD

ENDFUNC

Функция перевода каждого числа даты в число по сч 32

На входе - часть даты

На выходе - часть даты в сч 32

Продолжение приложения 1

FUNCTION fncSystem32

LPARAMETERS lcPartDate as Integer

IF lcPartDate >= 1 AND lcPartDate <= 9 THEN

lcPartDate = ALLTRIM(STR(lcPartDate))

RETURN lcPartDate

ENDIF

IF lcPartDate > 9 THEN

RETURN CHR(65 + (lcPartDate - 10))

ENDIF

ENDFUNC

Функция определения следующего порядкового номера пакета

На входе - дата

На выходе - номер

FUNCTION fncGetNextPakNum

LPARAMETERS ldDate as Date

LOCAL lnRetVal as Integer

IF !USED('ForNamePak')

USE (gcDataPath + "ForNamePak.dbf") IN 0 ALIAS ForNamePak

ENDIF

SELECT ForNamePak

LOCATE FOR ForNamePak.DateGen = ldDate

IF FOUND()

lnRetVal = ForNamePak.Num

ELSE

APPEND BLANK

replace DateGen WITH ldDate,;

Num WITH 0 IN ForNamePak

lnRetVal = ForNamePak.Num

ENDIF

IF lnRetVal >= VAL(gcAmountPak)

RETURN 0

ELSE

SELECT ForNamePak

LOCATE FOR ForNamePak.DateGen = ldDate

IF FOUND()

lnRetVal = lnRetVal + 1

replace Num WITH lnRetVal IN ForNamePak

ENDIF

ENDIF

USE IN ForNamePak

RETURN lnRetVal

ENDFUNC

FUNCTION ShellExecute

LPARAMETERS lcCmdName as String

DECLARE Long ShellExecute IN Shell32.dll Long hwnd, String Operation, String File,;

String parameters, String Directory, Integer ShowCmd

LOCAL lnReturn as Integer

lnReturn = ShellExecute(0, "open", lcCmdName,.null.,.null., 1)

RETURN lnReturn

ENDFUNC

Приложение 2

Листинг файла main.prg

CLOSE ALL

*SET STEP ON

DO prcSetting

OPEN DATABASE (gcDataPath + "exchange.dbc") SHARED

ON SHUTDOWN do prcExitApp

_screen.Visible =.T.

_screen.Caption = "Обмен информацией с ЕМСР"

_screen.WindowState = 2

_screen.Icon = (gcIcoPath + "snow.ico")

_screen.MaxButton =.F.

_screen.MinButton =.F.

_screen.Picture = (gcIcoPath + "PIC.JPG")

DO (gcMenuPath + "CustomMenu.mpr")

PUBLIC Tray as Object,;

goTimer as Object

Tray = CREATEOBJECT("systray.MyTray")

Tray.systray1.iconfile = (gcIcoPath + "snow.ico")

Tray.systray1.tiptext = "Обмен информацией с ЕМСР"

goTimer = CREATEOBJECT("MyTimer.MyTimer")

goTimer.init()

READ EVENTS

PROCEDURE prcSetting

PUBLICgnIDTypeIn, gnIDTypeOut as Integer

gnIDTypeIn = 1

gnIDTypeOut =2

SET SAFETY OFF

SET TALK OFF

SET DATE GERMAN

SET DECIMALS TO 0

LOCAL lcStr as String

IF !FILE(ADDBS(application.DefaultFilePath) + "Setting.dbf")

MESSAGEBOX ("Отсутствует файл с настройками программы",0,"Error")

DO prcExitApp

ELSE

USE (ADDBS(application.DefaultFilePath) + "Setting.dbf") IN 0 ALIAS Setting EXCLUSIVE

SELECT Setting

SCAN ALL

lcStr = "PUBLIC " + ALLTRIM(Setting.VarName) + " AS STRING "

Продолжение приложения 2

&lcStr

lcStr = ALLTRIM(Setting.VarName) + "='" + ALLTRIM(Setting.VarValue) + "'"

&lcStr

ENDSCAN

USE IN Setting

ENDIF

SET LIBRARY TO (gcProgPath + "mdlPackets.prg") ADDITIVE

SET LIBRARY TO (gcProgPath + "tasks.prg") ADDITIVE

SET CLASSLIB TO (gcClassPath + "systray.vcx") ALIAS systray ADDITIVE

SET CLASSLIB TO (gcClassPath + "myforms.vcx") ALIAS myforms ADDITIVE

SET CLASSLIB TO (gcClassPath + "mytimer.vcx") ALIAS mytimer ADDITIVE

ENDPROC

PROCEDURE prcExitApp

CLOSE TABLES ALL

CLOSE DATABASES ALL

RELEASE ALL

CLEAR EVENTS

QUIT

ENDPROC

Размещено на Allbest.ru