GLOBALS "_globals.4gl"
#==============================================================================
#
# Библиотека подпрограмм
#
#==============================================================================
#
# Содержание:
# ------------
#
#==============================================================================
#
DEFINE uslug_cnt INTEGER
,x_lpu_id INTEGER
,rp_file CHAR(100)
,svd_file CHAR(100)
,cnt INTEGER
,dp_count INTEGER
,tmp_out CHAR(1000) # Строка, возвращаемая QExpandMkbs
,with_prof SMALLINT # TRUE -- выбирать и профосмотры тоже
,full_poli SMALLINT # TRUE -- не группировать поликлинику
#
# ReestrQueries - Получение различных выборок по реестрам
#
FUNCTION ReestrQueries(w_prof, no_group)
DEFINE i INTEGER
,w_prof SMALLINT # TRUE -- выбирать и профосмотры тоже
,no_group SMALLINT # TRUE -- не группировать поликлинику
IF CheckPermissions(arm_rep_reestr, se_lect) <> 0 THEN # "ОТЧЕТЫ ПО РЕЕСТРАМ"
RETURN
END IF
LET with_prof = w_prof
LET full_poli = no_group
CALL ReeQuery001()
END FUNCTION
#
# QExpandMkbs - Преобразовать строку диагнозов для запроса
#
FUNCTION QExpandMkbs(in_mkb)
DEFINE i,j,k INTEGER
,in_mkb CHAR(100)
,tmp_s CHAR(100)
,s1,s2 CHAR(100)
,n1,n2 INTEGER
LET tmp_out = ""
WHILE LENGTH(in_mkb) > 0
# ----- Выделим подстроку до ближайшей запятой из занесем в tmp_s
LET j = ContainsString(in_mkb, ",", 1)
CASE
WHEN j = 0
LET tmp_s = GetFirstWord(in_mkb)
LET in_mkb = ""
WHEN j = 1
ERROR "Ошибка - повторная запятая в строке"
RETURN FALSE, ""
OTHERWISE
LET tmp_s = GetFirstWord(in_mkb[1,j-1])
LET in_mkb = in_mkb[j+1,100]
END CASE
# ----- Поищем тире в подстроке
LET k = ContainsString(tmp_s, "-", 1)
CASE
WHEN k = 0
IF LENGTH(tmp_out) > 0 THEN
LET tmp_out = tmp_out CLIPPED, ",'", tmp_s[1,3] CLIPPED, "'"
ELSE
LET tmp_out = "'", tmp_s[1,3] CLIPPED, "'"
END IF
WHEN k = 1
ERROR "Ошибка - тире должно находиться между диагнозами: ", tmp_s CLIPPED
RETURN FALSE, ""
# ----- Если подстрока содержит тире - пройдем по всему диапазону диагнозов
OTHERWISE
LET s1 = GetFirstWord(tmp_s[1,k-1])
LET s2 = GetFirstWord(tmp_s[k+1,100])
IF s1[1,1] = s2[1,1] THEN
IF IsInteger(s1[2,100]) AND IsInteger(s2[2,100]) THEN
LET n1 = s1[2,100]
LET n2 = s2[2,100]
IF n2 < n1 THEN
ERROR "Ошибка - второй диагноз в диапазоне меньше первого: ", tmp_s CLIPPED
RETURN FALSE, ""
END IF
IF (n1 >= 100) OR (n2 >= 100) THEN
ERROR "Ошибка - неправильные числа в диагнозах: ", tmp_s CLIPPED
RETURN FALSE, ""
END IF
FOR i = n1 TO n2
IF LENGTH(tmp_out) > 0 THEN
LET tmp_out = tmp_out CLIPPED, ",'", tmp_s[1,1], i USING "&&", "'"
ELSE
LET tmp_out = "'", tmp_s[1,1], i USING "&&", "'"
END IF
END FOR
ELSE
ERROR "Ошибка - неверные диагнозы в диапазоне: ", tmp_s CLIPPED
RETURN FALSE, ""
END IF
ELSE
ERROR "Ошибка - разные буквы диагнозов в диапазоне: ", tmp_s CLIPPED
RETURN FALSE, ""
END IF
END CASE
END WHILE
IF LENGTH(tmp_out) > 0 THEN
LET tmp_out = " AND mkb[1,3] IN (", tmp_out CLIPPED, ")"
END IF
RETURN TRUE
END FUNCTION
#
# ReeQuery001 - Выборка по реестрам поликлиники/стационара
#
FUNCTION ReeQuery001()
DEFINE p_ok INTEGER
,p_exit INTEGER
,tmp_str CHAR(80)
,i,j,k INTEGER
,adep_cnt INTEGER
,adep_qq INTEGER
,mkb_out CHAR(1000)
,mkb_ok SMALLINT
,sql_str CHAR(1000)
OPEN WINDOW MainWork_w AT 3,2
WITH FORM "ree_qqq"
ATTRIBUTE (BORDER, FORM LINE FIRST, COMMENT LINE LAST,
MESSAGE LINE LAST, PROMPT LINE LAST)
LET p_ok = FALSE
WHILE SrchAccount(TRUE, 0) # Только поиск / С/П нужно
LET p_exit = TRUE
CALL WaitAMoment(TRUE)
LET dp_count = 1
LET adep_cnt = 0
LET adep_qq = 0
INITIALIZE rquery_rows TO NULL
LET sql_str =
"SELECT s.lpu_id, d.mprofil_cod, d.med_id,",
" l.lpu_name, a.syn_onym, m.med_name, count(*)",
" FROM service s, diags d, medical m, lpu l, spr_asko a",
" WHERE s.ree_id =", cu_rheader.ree_id,
" AND s.serv_id = d.serv_id",
" AND d.med_id = m.med_id",
" AND s.lpu_id = l.lpu_id",
" AND a.kod1 = d.mprofil_cod",
" AND pay_flg <>", not_pay_cod,
" AND LENGTH(sname) > 0",
" AND mkb NOT LIKE 'В%'",
" AND mkb NOT LIKE 'V%'",
" AND ds_type =", main_ds_cod
IF with_prof = FALSE THEN
LET sql_str = sql_str CLIPPED, " AND mkb NOT LIKE 'Z%'"
END IF
LET sql_str = sql_str CLIPPED,
" GROUP BY 1,2,3,4,5,6",
" ORDER BY lpu_name, syn_onym, med_name"
PREPARE d070630a FROM sql_str
DECLARE d0610a CURSOR FOR d070630a
FOREACH d0610a INTO
lpu_ids[dp_count], prof_ids[dp_count], med_ids[dp_count],
rquery_rows[dp_count].sub_lpu, rquery_rows[dp_count].prof_name,
rquery_rows[dp_count].med_name, rquery_rows[dp_count].dep_cnt
LET adep_cnt = adep_cnt + rquery_rows[dp_count].dep_cnt
LET dp_count = dp_count + 1
END FOREACH
CALL SET_COUNT(dp_count) # ошибка в SET_COUNT() - не срабатывает AFTER ROW
CALL WaitAMoment(FALSE)
CALL HlpUniversal()
DISPLAY BY NAME adep_cnt, adep_qq
INPUT ARRAY rquery_rows WITHOUT DEFAULTS FROM q_arr.*
BEFORE ROW
LET i = ARR_CURR()
LET j = SCR_LINE()
DISPLAY rquery_rows[i].* TO q_arr[j].* ATTRIBUTE(REVERSE)
AFTER ROW
LET i = ARR_CURR()
LET j = SCR_LINE()
DISPLAY rquery_rows[i].* TO q_arr[j].*
AFTER FIELD dep_qq
LET i = ARR_CURR()
LET j = SCR_LINE()
LET adep_qq = 0
IF rquery_rows[i].dep_qq > rquery_rows[i].dep_cnt THEN
LET rquery_rows[i].dep_qq = rquery_rows[i].dep_cnt
END IF
IF rquery_rows[i].dep_qq < 0 THEN
LET rquery_rows[i].dep_qq = 0
END IF
DISPLAY rquery_rows[i].dep_qq TO q_arr[j].dep_qq ATTRIBUTE(REVERSE)
FOR k = 1 TO dp_count
IF rquery_rows[k].dep_qq > 0 THEN
LET adep_qq = adep_qq + rquery_rows[k].dep_qq
END IF
END FOR
DISPLAY BY NAME adep_qq
AFTER FIELD mkbs
LET i = ARR_CURR()
LET j = SCR_LINE()
CALL QExpandMkbs(rquery_rows[i].mkbs) RETURNING mkb_ok
IF NOT mkb_ok THEN
NEXT FIELD mkbs
END IF
ON KEY(F1)
CALL ShowHelpNum(help_index)
CALL HlpUniversal()
ON KEY (INTERRUPT, "ESCAPE", F10)
LET int_flag = 0
LET p_exit = FALSE
LET p_ok = FALSE
DISPLAY rquery_rows[i].* TO q_arr[j].*
EXIT INPUT
ON KEY(NEXTPAGE)
LET p_exit = TRUE
IF adep_qq > 0 THEN
LET p_ok = TRUE
ELSE
LET p_ok = FALSE
END IF
DISPLAY rquery_rows[i].* TO q_arr[j].*
EXIT INPUT
END INPUT
IF p_exit THEN
EXIT WHILE
END IF
END WHILE
CLOSE WINDOW MainWork_w
IF p_ok THEN
LET rp_file = SetReportFName()
LET svd_file = SetReportFName() CLIPPED, 'x'
CALL HlpIntrptReport()
CALL InitProgressBar("-", adep_qq)
LET sux.lpu_name = SelSprValue("spr_lpunam", "lpu_name", cu_aitog_h.lpu_id)
IF cu_rheader.s_p_cod = polik_cod THEN
START REPORT ReeRptPolSvod TO rp_file
START REPORT ReeRptPolXSvod TO svd_file
ELSE
START REPORT ReeRptStacSvod TO rp_file
START REPORT ReeRptPolXSvod TO svd_file
END IF
LET uslug_cnt = 0
FOR i = 1 TO dp_count
IF rquery_rows[i].dep_qq > 0 THEN
LET tmp_str = "Получение выборки по реестру ", GetCUReestrNum(),
" (", rquery_rows[i].prof_name CLIPPED, " -- ", rquery_rows[i].med_name CLIPPED, ")"
CALL SetProgressTitle(tmp_str)
CALL QExpandMkbs(rquery_rows[i].mkbs) RETURNING mkb_ok
IF cu_rheader.s_p_cod = polik_cod THEN
CALL SelectPolSvod(lpu_ids[i], prof_ids[i], med_ids[i], rquery_rows[i].dep_qq)
ELSE
CALL SelectStacSvod(lpu_ids[i], prof_ids[i], med_ids[i], rquery_rows[i].dep_qq)
END IF
END IF
END FOR
IF cu_rheader.s_p_cod = polik_cod THEN
FINISH REPORT ReeRptPolSvod
FINISH REPORT ReeRptPolXSvod
ELSE
FINISH REPORT ReeRptStacSvod
FINISH REPORT ReeRptPolXSvod
END IF
CALL DoneProgressBar()
LET tmp_str = "Реестр ", GetCUReestrNum()
CALL AddReportInfo("Выборка по реестру", tmp_str, rp_file)
CALL OutReport("Выборка услуг по реестру", rp_file)
CALL AddReportInfo("Сводный акт по выборке", tmp_str, svd_file)
CALL OutReport("Сводный акт по выборке", svd_file)
END IF
END FUNCTION
#
# SelectStacSvod - Выбрать указанное количество услуг по реестру стационара
#
FUNCTION SelectStacSvod(lp_id, prof_id, xmed_id, usl_cnt)
DEFINE lp_id,dp INTEGER
,prof_id INTEGER
,xmed_id INTEGER
,usl_cnt INTEGER
,sss CHAR(1500)
,i,j,kk,ii INTEGER
,ds_code INTEGER
,exp_ukl LIKE diags.ukl
,r_summa LIKE service.summa
INITIALIZE exp_ukl TO NULL
LET i = 0
LET sss = "SELECT s.*, d.*, (s.summa - s.u_summa) right_sum",
" FROM service s, diags d",
" WHERE s.serv_id = d.serv_id",
" AND ds_type =", main_ds_cod,
" AND ree_id =", cu_rheader.ree_id,
" AND pay_flg <>", not_pay_cod,
" AND LENGTH(sname) > 0",
" AND mkb NOT LIKE 'В%'",
" AND mkb NOT LIKE 'V%'",
" AND lpu_id =", lp_id,
" AND med_id =", xmed_id,
" AND mprofil_cod =", prof_id
IF with_prof = FALSE THEN
LET sss = sss CLIPPED, " AND mkb NOT LIKE 'Z%'"
END IF
LET sss = sss CLIPPED, tmp_out CLIPPED,
" ORDER BY right_sum DESC, sname, fname, lname"
LET dp = SelectCount("SELECT MAX(med_id) FROM medical") + 1
PREPARE d000118a FROM sss
DECLARE d990127a CURSOR FOR d000118a
FOREACH d990127a INTO cu_reestr.*, cu_diags[1].*, r_summa
IF int_flag <> 0 THEN
LET int_flag = 0
EXIT FOREACH
END IF
LET i = i + 1
IF i > usl_cnt THEN
EXIT FOREACH
END IF
LET uslug_cnt = uslug_cnt + 1
CALL SetProgressBar(uslug_cnt)
# --- Удалим район
LET ii = ContainsString(cu_reestr.address, "Р-Н,", 1)
IF (ii > 0) AND (ii < 45) THEN
# если есть индекс удалим и его
IF ContainsString(cu_reestr.address[ii-1,ii+10], "64", 1) THEN
LET cu_reestr.address = cu_reestr.address[ii+12, 50]
ELSE
LET cu_reestr.address = cu_reestr.address[ii+6, 50]
END IF
END IF
# --- (prof_id * dp + xmed_id) задают группировку
OUTPUT TO REPORT ReeRptStacSvod(prof_id * dp + xmed_id, prof_id, xmed_id, cu_reestr.ds_cod, exp_ukl)
OUTPUT TO REPORT ReeRptPolXSvod(prof_id, xmed_id, cu_reestr.ds_cod, exp_ukl)
END FOREACH
END FUNCTION
#
# SelectPolSvod - Выбрать указанное количество услуг по реестру поликлиники
#
FUNCTION SelectPolSvod(lp_id, prof_id, xmed_id, usl_cnt)
DEFINE lp_id,dp INTEGER
,prof_id INTEGER
,xmed_id INTEGER
,usl_cnt INTEGER
,sss CHAR(1500)
,i,j,kk,ii INTEGER
,tmp_sname LIKE service.sname
,tmp_fname LIKE service.fname
,tmp_lname LIKE service.lname
,tmp_bday LIKE service.bday
,tmp_mkb LIKE diags.mkb
,ds_code INTEGER
,exp_ukl LIKE diags.ukl
,tmp_sum LIKE service.summa
,tmp_cnt LIKE diags.serv_cnt
INITIALIZE exp_ukl TO NULL
LET sss = "SELECT ds_cod, sname, fname, lname, bday, mkb,",
" sum(serv_cnt) arr_cnt, sum(UslSumm(service.summa, pay_flg, u_summa)) arr_sum",
" FROM service, diags",
" WHERE service.serv_id = diags.serv_id",
" AND ds_type =", main_ds_cod,
" AND ree_id =", cu_rheader.ree_id,
" AND pay_flg <>", not_pay_cod,
" AND LENGTH(sname) > 0",
" AND mkb NOT LIKE 'В%'",
" AND mkb NOT LIKE 'V%'",
" AND lpu_id = ", lp_id,
" AND med_id = ", xmed_id,
" AND mprofil_cod =", prof_id
IF with_prof = FALSE THEN
LET sss = sss CLIPPED, " AND mkb NOT LIKE 'Z%'"
END IF
LET sss = sss CLIPPED, tmp_out CLIPPED,
" GROUP BY ds_cod,sname,fname,lname,bday,mkb",
" INTO TEMP tmp_rpt001 "
PREPARE d_0811a FROM sss
EXECUTE d_0811a
IF SelectCount("SELECT count(*) FROM tmp_rpt001") > 0 THEN
DECLARE d_0812b CURSOR FOR
SELECT ds_cod, sname, fname, lname, bday, mkb, arr_cnt, arr_sum
FROM tmp_rpt001
ORDER BY arr_sum DESC, arr_cnt DESC, sname, fname, lname, bday, mkb
LET i = 0
LET dp = SelectCount("SELECT MAX(med_id) FROM medical") + 1
FOREACH d_0812b INTO
ds_code, tmp_sname, tmp_fname, tmp_lname, tmp_bday, tmp_mkb, tmp_cnt, tmp_sum
IF int_flag <> 0 THEN
LET int_flag = 0
EXIT FOREACH
END IF
LET i = i + 1
IF i > usl_cnt THEN
EXIT FOREACH
END IF
LET uslug_cnt = uslug_cnt + tmp_cnt
CALL SetProgressBar(uslug_cnt)
DECLARE d_0812c CURSOR FOR
SELECT service.*, diags.*
FROM service, diags
WHERE service.serv_id = diags.serv_id
AND ds_type = main_ds_cod
AND ree_id = cu_rheader.ree_id
AND sname = tmp_sname
AND fname = tmp_fname
AND lname = tmp_lname
AND bday = tmp_bday
AND mkb = tmp_mkb
AND pay_flg <> not_pay_cod
AND lpu_id = lp_id
AND med_id = xmed_id
AND mprofil_cod = prof_id
ORDER BY arr_date DESC
LET kk = 0
FOREACH d_0812c INTO cu_reestr.*, cu_diags[1].*
IF (kk = 0) OR full_poli THEN
IF NOT full_poli THEN
LET cu_diags[1].serv_cnt = tmp_cnt
LET cu_reestr.summa = tmp_sum
END IF
# --- Удалим район
LET ii = ContainsString(cu_reestr.address, "Р-Н,", 1)
IF (ii > 0) AND (ii < 45) THEN
# если есть индекс удалим и его
IF ContainsString(cu_reestr.address[ii-1,ii+10], "64", 1) THEN
LET cu_reestr.address = cu_reestr.address[ii+12, 50]
ELSE
LET cu_reestr.address = cu_reestr.address[ii+6, 50]
END IF
END IF
# --- (prof_id * dp + xmed_id) задают группировку
OUTPUT TO REPORT ReeRptPolSvod(prof_id * dp + xmed_id, prof_id, xmed_id, cu_reestr.ds_cod, exp_ukl)
OUTPUT TO REPORT ReeRptPolXSvod(prof_id, xmed_id, cu_reestr.ds_cod, exp_ukl)
END IF
LET kk = kk + 1
END FOREACH
END FOREACH
END IF
DROP TABLE tmp_rpt001
END FUNCTION
#
# ReeRptPolXSvod - Отчет-печаталка сводного акта по реестру
#
REPORT ReeRptPolXSvod(prof_id, xmed_id, ds_code, exp_ukl)
DEFINE xfio CHAR(80)
,i INTEGER
,prof_id INTEGER
,xmed_id INTEGER
,ds_code INTEGER
,exp_ukl LIKE diags.ukl
,cnt_ INTEGER
OUTPUT
LEFT MARGIN 10
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 76
FORMAT
FIRST PAGE HEADER
LET cnt_ = 1
PRINT InitPrinter12(), InitPrinter8Lines(), " МСК 'АСКО-Забота'"
PRINT " СВОДНЫЙ АКТ"
PRINT " плановой экспертной оценки качества"
PRINT " медицинской помощи в лечебном учреждении"
IF with_prof = FALSE THEN
PRINT " УКЛ 1.0"
ELSE
PRINT " (с проф.осмотрами) УКЛ 1.0"
END IF
SKIP 2 LINES
PRINT " \"___\"___________200__ г."
SKIP 3 LINES
PRINT " 1. Проверяемое ЛПУ: ", SelSprValue("spr_lpunam", "lpu_name", cu_aitog_h.lpu_id)
PRINT
LET i = MONTH(cu_aitog_h.ree_date)
PRINT " 2. Анализируемый период: ", MonthName[i], " ",
YEAR(cu_aitog_h.ree_date) USING "####", " г."
PRINT
PRINT " 3. Период проведения экспертизы: ______________________"
PRINT
PRINT " 4. Экспертная группа: _________________________________"
PRINT
PRINT " _____________________________________________________"
SKIP 2 LINES
PRINT " -------------------------------------------------------"
PRINT " |Номер| | DS по |"
PRINT " | п/п | Фамилия,Имя,Отчество пациента | МКБ |"
PRINT " | | | |"
PRINT " -------------------------------------------------------"
PAGE HEADER
PRINT ASCII 12
PRINT " -------------------------------------------------------"
PRINT " |Номер| | DS по |"
PRINT " | п/п | Фамилия,Имя,Отчество пациента | МКБ |"
PRINT " | | | |"
PRINT " -------------------------------------------------------"
ON EVERY ROW
LET xfio = cu_reestr.sname CLIPPED, " ", cu_reestr.fname CLIPPED, " ", cu_reestr.lname CLIPPED
PRINT " ",
# cnt_ USING "####", " ",
" ",
xfio[1,39], " ",
cu_diags[1].mkb[1,7]
LET cnt_ = cnt_ + 1
ON LAST ROW
SKIP 5 LINES
PRINT " Нач. экспертного Главный врач ЛПУ"
PRINT " отдела МСК"
PRINT
PRINT " __________________ __________________"
SKIP 2 LINES
PRINT " М. П. М. П."
END REPORT
#
# ReeRptStacSvod - Отчет-печаталка выборки из реестра
#
REPORT ReeRptStacSvod(dp, prof_id, xmed_id, ds_code, exp_ukl)
DEFINE xfio CHAR(80)
,i,dp INTEGER
,prof_id INTEGER
,xmed_id INTEGER
,ds_code INTEGER
,exp_ukl LIKE diags.ukl
,dss CHAR(30)
,x_addr1 CHAR(60)
,x_addr2 CHAR(60)
OUTPUT
LEFT MARGIN 0
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 51
ORDER EXTERNAL BY dp, ds_code
FORMAT
FIRST PAGE HEADER
LET cnt = 1
LET i = MONTH(cu_aitog_h.ree_date)
PRINT InitPrinter12(), InitPrinter8Lines(), " МСК 'АСКО-Забота' ВЫБОРКА ИЗ РЕЕСТРА N ", GetCUReestrNum()
IF with_prof = FALSE THEN
PRINT " для плановой экспертизы качества медицинской помощи"
ELSE
PRINT " для плановой экспертизы качества медицинской помощи (с проф.осмотрами)"
END IF
PRINT " в стационаре ", SelSprValue("spr_lpunam", "lpu_name", cu_aitog_h.lpu_id),
" за ", MonthName[i] CLIPPED, " ", YEAR(cu_aitog_h.ree_date) USING "####", " г."
PRINT
PRINT "--------------------------------------------------------------------------------------------------------------------------------------"
PRINT "| N | район | Серия | | | Дата | Дата | Дата |DS по| К | УКЛ | |"
PRINT "|п/п|-------------|-------| Ф И О | Адрес |рождения|поступл.|выписки | МКБ |дни| ЛПУ | Сумма |"
PRINT "| | N мед.карты | Hомер | | | | | | | | | |"
PRINT "--------------------------------------------------------------------------------------------------------------------------------------"
PAGE HEADER
PRINT ASCII 12
PRINT "--------------------------------------------------------------------------------------------------------------------------------------"
PRINT "| N | район | Серия | | | Дата | Дата | Дата |DS по| К | УКЛ | |"
PRINT "|п/п|-------------|-------| Ф И О | Адрес |рождения|поступл.|выписки | МКБ |дни| ЛПУ | Сумма |"
PRINT "| | N мед.карты | Hомер | | | | | | | | | |"
PRINT "--------------------------------------------------------------------------------------------------------------------------------------"
ON EVERY ROW
NEED 2 LINES
LET dss = SelSprValue("spr_asko", "district", ds_code)
LET xfio = cu_reestr.fname CLIPPED, " ", cu_reestr.lname
CALL DivideString(cu_reestr.address, 30)
RETURNING x_addr1, x_addr2
PRINT cnt USING "####", " ",
dss[1,13], " ",
cu_reestr.p_ser USING "#######", " ",
cu_reestr.sname[1,22], " ",
x_addr1[1,30], " ",
cu_reestr.bday USING "dd.mm.yy", " ",
cu_diags[1].arr_date USING "dd.mm.yy", " ",
cu_diags[1].ex_date USING "dd.mm.yy", " ",
cu_diags[1].mkb[1,5], " ",
cu_diags[1].serv_cnt USING "###", " ",
cu_diags[1].ukl USING "#&.&&",
(cu_reestr.summa - cu_reestr.u_summa) USING "######&.&&"
PRINT " ",
cu_reestr.c_num[1,13], " ",
cu_reestr.p_num USING "#######", " ",
xfio[1,22], " ",
x_addr2[1,30]
LET cnt = cnt + 1
BEFORE GROUP OF dp
PRINT " ", GetFullDepName(prof_id, xmed_id)
AFTER GROUP OF dp
PRINT
ON LAST ROW
PRINT
PRINT
PRINT
PRINT " Зав. экспертным отд. __________________"
PRINT
PRINT " Главный врач __________________"
END REPORT
#
# ReeRptPolSvod - Отчет-печаталка выборки из реестра
#
REPORT ReeRptPolSvod(dp, prof_id, xmed_id, ds_code, exp_ukl)
DEFINE xfio CHAR(80)
,i,dp INTEGER
,prof_id INTEGER
,xmed_id INTEGER
,ds_code INTEGER
,exp_ukl LIKE diags.ukl
,dss CHAR(30)
,x_addr1 CHAR(60)
,x_addr2 CHAR(60)
OUTPUT
LEFT MARGIN 0
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 51
ORDER EXTERNAL BY dp, ds_code
FORMAT
FIRST PAGE HEADER
LET cnt = 1
LET i = MONTH(cu_aitog_h.ree_date)
PRINT InitPrinter12(), InitPrinter8Lines(), " МСК 'АСКО-Забота' ВЫБОРКА ИЗ РЕЕСТРА N ", GetCUReestrNum()
IF with_prof = FALSE THEN
PRINT " для плановой экспертизы качества медицинской помощи"
ELSE
PRINT " для плановой экспертизы качества медицинской помощи (с проф.осмотрами)"
END IF
PRINT " в поликлинике ", SelSprValue("spr_lpunam", "lpu_name", cu_aitog_h.lpu_id),
" за ", MonthName[i] CLIPPED, " ", YEAR(cu_aitog_h.ree_date) USING "####", " г."
PRINT
PRINT "-------------------------------------------------------------------------------------------------------------------------------------"
PRINT "| N | район | N | Серия | | | Дата | Дата |DS по|Колич| УКЛ | |"
PRINT "|п/п|-----------| мед. |-------| Ф И О | Адрес |рождения|последн.| МКБ |посещ| ЛПУ | Сумма |"
PRINT "| | ФИО врача | карты | Hомер | | | |посещен.| | | | |"
PRINT "-------------------------------------------------------------------------------------------------------------------------------------"
PAGE HEADER
PRINT ASCII 12
PRINT "-------------------------------------------------------------------------------------------------------------------------------------"
PRINT "| N | район | N | Серия | | | Дата | Дата |DS по|Колич| УКЛ | |"
PRINT "|п/п|-----------| мед. |-------| Ф И О | Адрес |рождения|последн.| МКБ |посещ| ЛПУ | Сумма |"
PRINT "| | ФИО врача | карты | Hомер | | | |посещен.| | | | |"
PRINT "-------------------------------------------------------------------------------------------------------------------------------------"
ON EVERY ROW
LET dss = SelSprValue("spr_asko", "district", ds_code)
LET xfio = cu_reestr.fname CLIPPED, " ", cu_reestr.lname
CALL DivideString(cu_reestr.address, 30)
RETURNING x_addr1, x_addr2
NEED 2 LINES
PRINT cnt USING "####", " ",
dss[1,11], " ",
cu_reestr.c_num[1,8],
cu_reestr.p_ser USING "#######", " ",
cu_reestr.sname[1,22], " ",
x_addr1[1,30], " ",
cu_reestr.bday USING "dd.mm.yy", " ",
cu_diags[1].arr_date USING "dd.mm.yy", " ",
cu_diags[1].mkb[1,5], " ",
cu_diags[1].serv_cnt USING "###.#", " ",
cu_diags[1].ukl USING "&.&&", " ",
(cu_reestr.summa - cu_reestr.u_summa) USING "#####&.&&"
PRINT " ",
cu_reestr.dc_fio[1,19], " ",
cu_reestr.p_num USING "#######", " ",
xfio[1,22], " ",
x_addr2[1,30]
LET cnt = cnt + 1
BEFORE GROUP OF dp
PRINT " ", GetFullDepName(prof_id, xmed_id)
AFTER GROUP OF dp
PRINT
ON LAST ROW
PRINT
PRINT
PRINT
PRINT " Зав. экспертным отд. __________________"
PRINT
PRINT " Зав. поликлиникой __________________"
PRINT
PRINT " Главный врач __________________"
END REPORT
#
# ReestrDouble - Выборка из реестра пациентов, госпитализированных более одного раза
#
FUNCTION ReestrDouble()
DEFINE i,j,k INTEGER
,tmp_str CHAR(100)
,sss,zzz CHAR(500)
,x_sname LIKE service.sname
,x_fname LIKE service.fname
,x_lname LIKE service.lname
,x_mkb LIKE diags.mkb
,x_fio CHAR(80)
,accnt_nums CHAR(200)
,old_arr,new_arr DATE
,old_ex,new_ex DATE
,old_id,new_id INTEGER
IF InputLPUPeriodDate() > 0 THEN
ELSE
RETURN
END IF
CALL HlpIntrptReport()
LET tmp_str = "Получение отчета по повторным госпитализациям (",
cu_lpu.lpu_name CLIPPED, ")"
CALL InitProgressBar(tmp_str, 1)
LET accnt_nums = GetAccnts(date_begin, date_end, cu_lpu.lpu_id, stac_cod)
IF LENGTH(accnt_nums) > 0 THEN
LET rp_file = SetReportFName()
START REPORT RptReeDouble TO rp_file
LET sss = "SELECT sname, fname, lname, mkb[1,3], count(*)",
" FROM service, diags",
" WHERE service.serv_id = diags.serv_id", accnt_nums CLIPPED,
" AND ds_type = ", main_ds_cod,
" AND pay_flg = ", pay_cod,
" GROUP BY 1,2,3,4",
" HAVING count(*) > 2",
" ORDER BY 5 DESC, 1,2,3"
PREPARE d0825b FROM sss
DECLARE d0825c CURSOR FOR d0825b
FOREACH d0825c INTO x_sname, x_fname, x_lname, x_mkb, j
LET x_fio = x_sname CLIPPED, " ", x_fname CLIPPED, " ", x_lname CLIPPED
LET zzz = "SELECT service.serv_id, arr_date, ex_date",
" FROM service, diags",
" WHERE service.serv_id = diags.serv_id", accnt_nums CLIPPED,
" AND ds_type = ", main_ds_cod,
" AND pay_flg = ", pay_cod,
" AND sname = '", escape_quotes(x_sname) CLIPPED, "'",
" AND fname = '", escape_quotes(x_fname) CLIPPED, "'",
" AND lname = '", escape_quotes(x_lname) CLIPPED, "'",
" AND mkb[1,3] = '", escape_quotes(x_mkb) CLIPPED, "'",
" ORDER BY arr_date, ex_date"
PREPARE d0825d FROM zzz
DECLARE d0825e CURSOR FOR d0825d
FOREACH d0825e INTO new_id, new_arr, new_ex
OUTPUT TO REPORT RptReeDouble(x_fio, new_id)
END FOREACH
END FOREACH
CALL SetProgressBar(1)
FINISH REPORT RptReeDouble
CALL DoneProgressBar()
LET tmp_str = "Повт.госпит.(", cu_lpu.lpu_name CLIPPED, ")"
CALL AddReportInfo(tmp_str, DatePeriodStr(), rp_file)
CALL OutReport(tmp_str, rp_file)
ELSE
CALL DoneProgressBar()
END IF
END FUNCTION
#
# RptReeDouble - Отчет-печаталка повторных госпитализаций
#
REPORT RptReeDouble(x_fio, x_id)
DEFINE i,j,x_id INTEGER
,x_fio CHAR(80)
,dp CHAR(60)
,tmp_fio CHAR(80)
OUTPUT
LEFT MARGIN 0
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 77
ORDER EXTERNAL BY x_fio
FORMAT
FIRST PAGE HEADER
PRINT InitPrinter17(), InitPrinter8Lines(), " Повторные госпитализации. ", cu_lpu.lpu_name CLIPPED, ". ", DatePeriodStr()
PRINT
PRINT "Серия Номер Ф И О пациента Отделение, УБ DS Даты поступл/выписки К-дни Сумма"
PRINT "----- ------- -------------------------------- ----------------------------------- ------ ---------- ---------- ----- ----------"
PAGE HEADER
PRINT ASCII 12, InitPrinter17()
PRINT "Серия Номер Ф И О пациента Отделение, УБ DS Даты поступл/выписки К-дни Сумма"
PRINT "----- ------- -------------------------------- ----------------------------------- ------ ---------- ---------- ----- ----------"
AFTER GROUP OF x_fio
PRINT
ON EVERY ROW
SELECT *
INTO cu_reestr.*
FROM service
WHERE serv_id = x_id
CALL LoadDS(cu_reestr.serv_id)
LET dp = GetDepName(cu_diags[1].med_id)
IF cu_lpu.lpu_id <> cu_reestr.lpu_id THEN
LET dp = dp CLIPPED, ", ", SelSprValue("spr_lpuall", "lpu_name", cu_reestr.lpu_id)
END IF
LET tmp_fio = cu_reestr.sname CLIPPED, " ", cu_reestr.fname CLIPPED, " ", cu_reestr.lname CLIPPED
PRINT cu_reestr.p_ser USING "#####", " ",
cu_reestr.p_num USING "#######", " ",
tmp_fio[1,32], " ",
dp[1,35], " ",
cu_diags[1].mkb[1,6], " ",
cu_diags[1].arr_date USING "dd.mm.yyyy", " ",
cu_diags[1].ex_date USING "dd.mm.yyyy", " ",
cu_diags[1].serv_cnt USING "###&", " ",
(cu_reestr.summa - cu_reestr.u_summa) USING "#####&.&&"
# ON LAST ROW
# PRINT "------------------------------ ------------------------------ ------ ---------- ---------- -----"
END REPORT
{
#
# InputReePeriod - Ввод периода для отчета по реестрам
#
FUNCTION InputReePeriod(header)
DEFINE i,j,k INTEGER
,p__exit SMALLINT
,p_modify
,p_err SMALLINT
,header CHAR(100)
,temp CHAR(100)
OPEN WINDOW MainWork_w AT 8,22
WITH FORM "ree_pdbl"
ATTRIBUTE (BORDER, FORM LINE FIRST, COMMENT LINE LAST,
MESSAGE LINE LAST, PROMPT LINE LAST)
INITIALIZE sux.lpu_name TO NULL
LET month_cnt = 3
LET x_lpu_id = 0
LET x_month = MONTH(TODAY - 27)
LET sux.year = YEAR(TODAY - 27)
LET x_month_cod = SelectMonthCod(x_month)
LET sux.month_name = SelSprValue("spr_asko", "month", x_month_cod)
CALL HlpUniversal()
DISPLAY BY NAME header
LET p__exit = TRUE
INPUT BY NAME month_cnt, sux.month_name, sux.year, sux.lpu_name
WITHOUT DEFAULTS
BEFORE FIELD month_name
LET temp = sux.month_name
BEFORE FIELD lpu_name
LET temp = sux.lpu_name
BEFORE FIELD year
LET temp = sux.year
AFTER FIELD month_name
CALL SprProcess(temp, x_month_cod, p_modify, "Месяц", "month", sux.month_name)
RETURNING sux.month_name, x_month_cod, p_modify, p_err
DISPLAY BY NAME sux.month_name
IF p_err THEN
NEXT FIELD month_name
END IF
LET x_month = SelectMonthNum(x_month_cod)
# SELECT syn_onym
# INTO x_month
# FROM spr_asko
# WHERE spr_nam = "month"
# AND kod1 = x_month_cod
# IF STATUS = NOTFOUND THEN
# LET x_month = 0
# END IF
AFTER FIELD year
LET sux.year = CheckYear2000(sux.year, 1)
DISPLAY BY NAME sux.year
AFTER FIELD lpu_name
CALL XSprProcess(temp, x_lpu_id, p_modify, "Название ЛПУ",
"spr_lpunam", "lpu_name", sux.lpu_name)
RETURNING sux.lpu_name, x_lpu_id, p_modify, p_err
DISPLAY BY NAME sux.lpu_name
IF p_err THEN
NEXT FIELD lpu_name
END IF
ON KEY(F1)
CALL ShowHelpNum(help_index)
CALL HlpUniversal()
ON KEY(F5)
CASE
WHEN INFIELD(month_name)
CALL SprF5Process(temp, x_month_cod, p_modify, "Месяц", "month")
RETURNING sux.month_name, x_month_cod, p_modify
DISPLAY BY NAME sux.month_name
LET x_month = SelectMonthNum(x_month_cod)
# SELECT syn_onym
# INTO x_month
# FROM spr_asko
# WHERE spr_nam = "month"
# AND kod1 = x_month_cod
# IF STATUS = NOTFOUND THEN
# LET x_month = 0
# END IF
WHEN INFIELD(lpu_name)
CALL XSprF5Process(temp, x_lpu_id, p_modify, "Название ЛПУ",
"spr_lpunam", "lpu_name")
RETURNING sux.lpu_name, x_lpu_id, p_modify
DISPLAY BY NAME sux.lpu_name
END CASE
ON KEY(INTERRUPT,ESCAPE,F10)
LET int_flag = 0
LET p__exit = TRUE
EXIT INPUT
ON KEY(NEXTPAGE)
IF (x_month > 0) AND (sux.year > 0) THEN
IF month_cnt > 0 THEN
LET p__exit = FALSE
EXIT INPUT
ELSE
LET i = ErrMessage("Необходимо указать интервал выборки.", "", "", 0)
END IF
ELSE
LET i = ErrMessage("Необходимо правильно указать дату.", "", "", 0)
END IF
END INPUT
CLOSE WINDOW MainWork_w
RETURN p__exit
END FUNCTION
#
# ReeBestMkb - Выборка из реестра наиболее часто встречающихся диагнозов
#
FUNCTION ReeBestMkb()
DEFINE i,j,k,doc_count INTEGER
,p__exit SMALLINT
,tmp_str,temp CHAR(100)
,sss,zzz,xxx CHAR(300)
,d_date DATE
,x_mkb LIKE diags.mkb
,accnt_nums CHAR(100)
,old_lpu_id
,old_dep_id INTEGER
,dp_name CHAR(40) # Название отделения
,x_dep_id INTEGER
IF InputReePeriod(" ОТЧЕТ ПО ЧАСТО ВСТРЕЧАЮЩИМСЯ DS ") THEN
RETURN
END IF
LET d_date = MDY(x_month, 1, sux.year)
LET xxx = "SELECT kod1, na_me",
" FROM spr_lpunam"
IF x_lpu_id > 0 THEN
LET doc_count = 1
LET xxx = xxx CLIPPED, " WHERE kod1 =", x_lpu_id
ELSE
LET doc_count = SelectCount("SELECT count(*) FROM spr_lpunam")
IF doc_count = 0 THEN
LET i = ErrMessage("Больниц не обнаружено. Вы уверены, что база не пустая ?", "", "", 0)
RETURN
END IF
END IF
LET xxx = xxx CLIPPED, " ORDER BY na_me"
CALL HlpIntrptReport()
CALL InitProgressBar("Получение отчета по часто встречающимся ds", doc_count)
LET rp_file = SetReportFName()
START REPORT RptReeBestMkb TO rp_file
LET i = 0
PREPARE d0828z FROM xxx
DECLARE d0828a CURSOR FOR d0828z
FOREACH d0828a INTO cu_lpu.lpu_id, cu_lpu.lpu_name
IF int_flag <> 0 THEN
LET int_flag = 0
LET p__exit = TRUE
EXIT FOREACH
END IF
LET i = i + 1
CALL SetProgressBar(i)
LET tmp_str = "Получение отчета по часто встречающимся ds (",
cu_lpu.lpu_name CLIPPED, ")"
CALL SetProgressTitle(tmp_str)
LET accnt_nums = GetLastNAccnt(d_date, cu_lpu.lpu_id, stac_cod, month_cnt, aitog_main_cod)
IF LENGTH(accnt_nums) > 0 THEN
ELSE
CONTINUE FOREACH
END IF
LET sss = "SELECT lpu_id, med_id, mkb[1,3], count(*)",
" FROM service, diags",
" WHERE service.serv_id = diags.serv_id", accnt_nums CLIPPED,
" AND ds_type = ", main_ds_cod,
" GROUP BY 1,2,3",
" HAVING count(*) > 1",
" ORDER BY 1,2,4 DESC, 3"
PREPARE d0828b FROM sss
DECLARE d0828c CURSOR FOR d0828b
LET old_lpu_id = 0
LET old_dep_id = 0
FOREACH d0828c INTO cu_lpu.lpu_id, x_dep_id, x_mkb, j
IF (cu_lpu.lpu_id <> old_lpu_id) OR
(x_dep_id <> old_dep_id) THEN
LET k = 0
LET old_lpu_id = cu_lpu.lpu_id
LET old_dep_id = x_dep_id
END IF
LET k = k + 1
IF k > 20 THEN
CONTINUE FOREACH
END IF
LET cu_lpu.lpu_name = SelSprValue("spr_lpuall", "lpu_name", cu_lpu.lpu_id)
LET dp_name = GetDepName(x_dep_id)
OUTPUT TO REPORT RptReeBestMkb(cu_lpu.lpu_name, dp_name, x_mkb, j)
END FOREACH
END FOREACH
FINISH REPORT RptReeBestMkb
CALL DoneProgressBar()
IF NOT p__exit THEN
LET tmp_str = "За ", month_cnt USING "<<<", " мес. по ",
sux.month_name CLIPPED, " ", sux.year USING "####", " г."
IF x_lpu_id > 0 THEN
LET tmp_str = tmp_str CLIPPED,
" Для ", SelSprValue("spr_lpunam", "lpu_name", x_lpu_id)
END IF
CALL AddReportInfo("Часто встречающиеся ds", tmp_str, rp_file)
CALL OutReport("Часто встречающиеся ds", rp_file)
END IF
END FUNCTION
#
# RptReeBestMkb - Отчет-печаталка часто встречающихся ds
#
REPORT RptReeBestMkb(lpu_nam, dep_nam, mkb, mkb_cnt)
DEFINE i,j INTEGER
,lpu_nam CHAR(40)
,dep_nam CHAR(40)
,mkb CHAR(10)
,mkb_cnt INTEGER
,mkb_nam CHAR(200)
,x_mkb CHAR(10)
OUTPUT
LEFT MARGIN 0
TOP MARGIN 0
BOTTOM MARGIN 0
PAGE LENGTH 78
ORDER EXTERNAL BY lpu_nam, dep_nam
FORMAT
FIRST PAGE HEADER
PRINT InitPrinter17(), InitPrinter8Lines()
PAGE HEADER
PRINT ASCII 12, InitPrinter17()
BEFORE GROUP OF lpu_nam
PRINT "===== ", lpu_nam CLIPPED, " ================="
BEFORE GROUP OF dep_nam
PRINT " ", dep_nam CLIPPED
AFTER GROUP OF lpu_nam
PRINT
AFTER GROUP OF dep_nam
PRINT
ON EVERY ROW
IF IsInteger(mkb) THEN
LET i = mkb
LET x_mkb = i USING "&&&"
ELSE
LET x_mkb = mkb
END IF
LET mkb_nam = "Неопознанный диагноз"
SELECT mkb_name
INTO mkb_nam
FROM spr_mkb
WHERE kod1 = x_mkb
PRINT mkb_cnt USING "#####&", " ",
mkb[1,3], " ",
mkb_nam[1,120]
ON LAST ROW
PRINT "------------------"
END REPORT
}