Initial commit

9 files changed, 597 insertions, 0 deletions

diff --git a/biometry.asy b/biometry.asy
new file mode 100644
index 0000000..294c212
--- /dev/null
+++ b/biometry.asy
@@ -0,0 +1,38 @@
+pair pair_ratio(pair a, pair b, real fraction) {
+     return a + (b - a)*fraction;
+}
+real real_ratio(real a, real b, real fraction) {
+     return a + (b - a)*fraction;
+}
+void draw_tic(pair a, pair b, real fraction, real tic_height, bool label) {
+     pair pt1 = pair_ratio(a, b, fraction);
+     pair pt2 = pt1 - (0, tic_height);
+     draw(pt1 -- pt2);
+     if (label) {
+     	label(format("%f\%", fraction*100), pt2, S);
+     }
+}
+void draw_marker(pair a, pair b, real value, real marker_height) {
+     pair markpt = pair_ratio(a, b, value);
+     pair pt = (markpt.x, markpt.y + marker_height);
+     label("*", pt);
+}
+void draw_scale(pair a, pair b, real value, real tic_height) {
+     draw(pair_ratio(a, b, 0) -- pair_ratio(a, b, 1));
+     draw_tic(a, b, 0.05, tic_height, true);
+     draw_tic(a, b, 0.5, tic_height, true);
+     draw_tic(a, b, 0.95, tic_height, true);
+     draw_tic(a, b, 0.25, 0.5*tic_height, false);
+     draw_tic(a, b, 0.75, 0.5*tic_height, false);
+     draw_marker(a, b, value, 0.5*tic_height);
+}
+void draw_biometry(string param, string param_age, real percentile) {
+     real width = 100;
+     real height = 75;
+
+     label(param, (width/2, 2*height/3), N);
+     label(param_age, (width/2, 2*height/3), S);
+     pair scale1 = (0.1*width, 0.25*height);
+     pair scale2 = (0.9*width, 0.25*height);
+     draw_scale(scale1, scale2, percentile/100, 0.1*height);
+}
\ No newline at end of file
diff --git a/ksh-biometry.el b/ksh-biometry.el
new file mode 100644
index 0000000..0e5f1d7
--- /dev/null
+++ b/ksh-biometry.el
@@ -0,0 +1,41 @@
+(defun draw-biometry (param-name param param-age percentile)
+  (let ((temp-script-file (make-temp-script
+			   (format "%s %s" param-name param)
+			   param-age (string-to-number percentile))))
+    (message "Drawing %s..." temp-script-file)
+    (shell-command
+     (format "asy -f pdf -o %s %s" (file-name-directory temp-script-file) temp-script-file))
+    (delete-file temp-script-file)
+    (format "%s.pdf" temp-script-file)))
+
+(defun make-temp-script (param param-age percentile)
+  (let ((temp-script-file (make-temp-file "biometry")))
+    (with-temp-file temp-script-file
+      (insert "include \"biometry\";\n")
+      (insert (format
+	       "draw_biometry(\"%s\", \"%s\", %d);"
+	       param param-age percentile)))
+    temp-script-file))
+
+(defun insert-biometry (readings)
+  (princ
+   (format "[[%s]]\n"
+	   (crop-pdf
+	    (combine-pdfs
+	     (mapcar (lambda (reading)
+			  (apply 'draw-biometry
+				 (mapcar 'get-field reading))) readings))))))
+
+(defun combine-pdfs (pdfs)
+  (let ((temp-combination (make-temp-file "pdfjam" nil ".pdf")))
+    (apply 'call-process "pdfjam" nil nil nil
+	   "--nup" "4x1"
+	   "--outfile" temp-combination pdfs)
+    (mapc 'delete-file pdfs)
+    temp-combination))
+
+(defun crop-pdf (pdf)
+  (message "Cropping %s..." pdf)
+  (let ((output-pdf (format "%s-crop.pdf" (file-name-sans-extension pdf))))
+    (shell-command (format "pdfcrop %s %s" pdf output-pdf))
+    (delete-file pdf) output-pdf))
diff --git a/ksh-discharge.el b/ksh-discharge.el
new file mode 100644
index 0000000..9bd0e6d
--- /dev/null
+++ b/ksh-discharge.el
@@ -0,0 +1,63 @@
+;; -*- lexical-binding: t -*-
+
+(load "ksh-forms-improved.el")
+
+;; Datafile path and fields
+(setq forms-file (expand-file-name "discharge.dat" ksh-data-path))
+(setq forms-number-of-fields
+      (forms-enumerate
+       '(ip-op-no patient-name age sex address admission-date
+		  discharge-date diagnosis surgical-procedure
+		  history clinical-examination course-in-hospital
+		  investigation treatment condition-on-discharge advice)))
+
+;; Default values for fields
+(setq default-field-values
+      `((,sex . "F")
+	(,advice . "Triple A Cal Forte - 30 Cap")))
+
+;; Format specification for form display
+(setq forms-format-list
+      (append
+       (list "Discharge Summary\n\n")
+       (form-entries
+	'(("IP/OP No" . ip-op-no)
+	  ("Age" . age)
+	  ("Sex" . sex)
+	  ("Name of Patient" . patient-name)
+	  ("Address" . address)
+	  ("Date of Admission" . admission-date)
+	  ("Date of Discharge" . discharge-date)
+	  ("Diagnosis" . diagnosis)
+	  ("Surgical Procedure" . surgical-procedure)
+	  ("History" . history)
+	  ("Clinical Examination" . clinical-examination)
+	  ("Course in Hospital" . course-in-hospital)
+	  ("Investigation" . investigation)
+	  ("Treatment" . treatment)
+	  ("Condition on Discharge" . condition-on-discharge)
+	  ("Advice" . advice)))))
+
+(setq form-to-org
+      (lambda ()
+	(with-output-to-string
+	  (make-report-header "DISCHARGE SUMMARY")
+	  (single-line-org-entries
+	   `(("IP/OP No" . ,ip-op-no)
+	     ("Age" . ,age)
+	     ("Sex" . ,sex)
+	     ("Name of Patient" . ,patient-name)
+	     ("Date of Admission" . ,admission-date)
+	     ("Date of Discharge" . ,discharge-date)))
+	  (multi-line-org-entries
+	   `(("Address" . ,address)
+	     ("Diagnosis" . ,diagnosis)
+	     ("Surgical Procedure" . ,surgical-procedure)
+	     ("History" . ,history)
+	     ("Clinical Examination" . ,clinical-examination)
+	     ("Course in Hospital" . ,course-in-hospital)
+	     ("Investigation" . ,investigation)
+	     ("Treatment" . ,treatment)
+	     ("Condition on Discharge" . ,condition-on-discharge)
+	     ("Advice" . ,advice)
+	     ("Signature of the Medical Officer" . ""))))))
diff --git a/ksh-emacs-init.el b/ksh-emacs-init.el
new file mode 100644
index 0000000..1bd14ab
--- /dev/null
+++ b/ksh-emacs-init.el
@@ -0,0 +1,14 @@
+;; Path to data files
+(setq ksh-data-path (expand-file-name "data" ksh-path))
+
+;; Printing settings
+(setq printer-name "HP_P2055DN_CPL")
+(setq lpr-switches
+      (list "-o" "sides=two-sided-long-edge"
+	    "-o" "fit-to-page"))
+
+;; Find forms
+(forms-find-file (expand-file-name "ksh-discharge.el" ksh-path))
+;; (forms-find-file (expand-file-name "ksh-scan1.el" ksh-path))
+(forms-find-file (expand-file-name "ksh-scan2.el" ksh-path))
+(forms-find-file (expand-file-name "ksh-scan3.el" ksh-path))
diff --git a/ksh-forms-improved.el b/ksh-forms-improved.el
new file mode 100644
index 0000000..a8a2e12
--- /dev/null
+++ b/ksh-forms-improved.el
@@ -0,0 +1,95 @@
+;; -*- lexical-binding: t -*-
+
+(require 'org)
+(require 'subr-x)
+(require 'cl-lib)
+
+;; General settings
+(setq doc-view-continuous t)
+(setq lpr-switches (list "-o sides=two-sided-long-edge"
+			 "-o fit-to-page"))
+(setq export-properties
+      (list :section-numbers nil
+	    :with-toc nil))
+
+;; Printing
+(defun print-report ()
+  (interactive)
+  (shell-command
+   (format "lpr -o sides=two-sided-long-edge -o fit-to-page %s" (buffer-file-name))))
+(defalias 'print-buffer 'print-report)
+
+;; Utilities
+(defmacro setfun (function-name function)
+  "Set functions like using define in scheme"
+  `(defun ,function-name (&rest args)
+     (apply ,function args)))
+
+(defun mapped (mapper function)
+  "Apply the mapping function MAPPER on function FUNCTION"
+  (lambda (arglist)
+    (funcall mapper function arglist)))
+
+(defun set-values (record values)
+  "Set record RECORD to values in alist VALUES"
+  (mapc (lambda (field-value)
+	  (aset record (car field-value) (cdr field-value))) values))
+
+;; Entry creation functions for form display
+(defun form-entry (label-field)
+  (list (format "%s\n" (car label-field))
+	(cdr label-field) "\n\n"))
+
+(setfun form-entries (mapped 'cl-mapcan 'form-entry))
+
+(defun new-record-filter (record)
+  (set-values record default-field-values)
+  record)
+(setq forms-new-record-filter 'new-record-filter)
+
+;; Entry creation functions for org export
+(defun make-org-entry-function (format-string)
+  (lambda (label-field)
+    (let* ((label (car label-field))
+	   (field-no (cdr label-field))
+	   (value (get-field field-no)))
+      (if value
+	  (princ (format format-string label
+			 (replace-regexp-in-string "\n" "\n\n" value)))
+	(user-error "Field \"%s\" should not be blank" label)))))
+
+(defun get-field (field)
+  "Parse form and return field FIELD from form"
+  (cond ((integerp field) (nth (1- field) (forms--parse-form)))
+	((stringp field) field)))
+
+(setfun single-line-org-entry (make-org-entry-function "*%s:* %s\n\n"))
+(setfun multi-line-org-entry (make-org-entry-function "\n* %s\n%s\n\n"))
+(setfun single-line-org-entries (mapped 'mapc 'single-line-org-entry))
+(setfun multi-line-org-entries (mapped 'mapc 'multi-line-org-entry))
+
+(defun text-if-non-blank (text)
+  (if (and text (not (string-blank-p text)))
+      (princ (format "%s\n\n" text))))
+
+(defun org-keyword (keyword-value)
+  (princ (format "#+%s: %s\n" (car keyword-value) (cdr keyword-value))))
+
+(defun org-latex-header (header)
+  (org-keyword (cons "LATEX_HEADER" header)))
+
+(setfun org-keywords (mapped 'mapc 'org-keyword))
+(setfun org-latex-headers (mapped 'mapc 'org-latex-header))
+
+(defun forms-print ()
+  (interactive)
+  (find-file (org-to-pdf (funcall form-to-org))))
+
+(defun org-to-pdf (org-source)
+  (let ((tex-file-path (format "%s.tex" (make-temp-file "report"))))
+    (with-temp-buffer
+      (insert org-source)
+      (org-export-to-file 'latex tex-file-path
+	nil nil nil nil export-properties 'org-latex-compile))))
+
+(make-variable-buffer-local 'form-to-org)
diff --git a/ksh-report-header.el b/ksh-report-header.el
new file mode 100644
index 0000000..6194250
--- /dev/null
+++ b/ksh-report-header.el
@@ -0,0 +1,20 @@
+(defun make-report-header (title)
+  (org-keywords
+   '(("TITLE" . "Kuzhanthai Sanjeevi Hospital")
+     ("AUTHOR" . "Dr. Serene Isaac, MD, DGO, DNB")))
+  (org-latex-headers
+   `("\\usepackage{fullpage}"
+     "\\usepackage{nopageno}"
+     "\\usepackage[ddmmyyyy]{datetime}"
+     "\\renewcommand{\\dateseparator}{-}"
+     "\\setlength{\\parindent}{0cm}"
+     "\\usepackage[tiny]{titlesec}"
+     "\\usepackage{wasysym}"
+     "\\usepackage{titling}"
+     ,(format "\\pretitle{\\hrule \\begin{center} {\\Large \\textbf{%s}} \\par \\small \\sc}" title)
+     "\\posttitle{\\par 17, Jawahar Street, Ramavarmapuram, Nagercoil - 629001 \\par \\phone \\, 223374 \\end{center}}"
+     "\\preauthor{}"
+     "\\postauthor{\\par Obstetrician and Gynaecologist}"
+     "\\predate{\\hfill \\textbf{Date: }}"
+     "\\date{\\today}"
+     "\\postdate{\\vspace{1em} \\hrule \\par}")))
diff --git a/ksh-scan2.el b/ksh-scan2.el
new file mode 100644
index 0000000..75f3ae4
--- /dev/null
+++ b/ksh-scan2.el
@@ -0,0 +1,177 @@
+;; -*- lexical-binding: t -*-
+
+(load "ksh-forms-improved.el")
+(load "ksh-report-header.el")
+(load "ksh-biometry.el")
+
+;; Datafile path and fields
+(setq forms-file (expand-file-name "scan2.dat" ksh-data-path))
+(setq forms-number-of-fields
+      (forms-enumerate
+       '(ip-op-no patient-name age sex visit-date lmp-date lmp-edd
+		    scan
+		    maternal-cervix maternal-internal-os
+		    survey-presentation survey-placenta survey-liquor
+		    survey-umbilical-cord survey-fetal-activity survey-cardiac-activity
+		    biometry-bpd biometry-bpd-age biometry-bpd-percentile
+		    biometry-hc biometry-hc-age biometry-hc-percentile
+		    biometry-ac biometry-ac-age biometry-ac-percentile
+		    biometry-fl biometry-fl-age biometry-fl-percentile
+		    biometry-fetal-weight
+		    extended-foot-length extended-tcd
+		    anatomy-intracranial anatomy-neck anatomy-spine
+		    anatomy-face anatomy-lungs anatomy-heart
+		    anatomy-abdominal-situs anatomy-kidneys-bladder
+		    anatomy-long-bones
+		    impression-gestational-age impression-menstrual-age
+		    impression-corrected-edd impression-notes
+		    sonologist)))
+
+;; Default values for fields
+(setq default-field-values
+      `((,sex . "F")
+	(,survey-presentation . "cephalic")
+	(,survey-placenta . "posterior")
+	(,survey-liquor . "normal")
+	(,survey-fetal-activity . "present")
+	(,survey-cardiac-activity . "present")
+	(,anatomy-intracranial . "normal")
+	(,anatomy-neck . "normal. No evidence of significant open neural tube defect")
+	(,anatomy-spine . "normal")
+	(,anatomy-face . "normal")
+	(,anatomy-lungs . "normal")
+	(,anatomy-heart . "normal")
+	(,anatomy-abdominal-situs . "normal")
+	(,anatomy-kidneys-bladder . "normal")
+	(,anatomy-long-bones . "normal for the period of gestation")
+	(,sonologist . "Dr. Bala Bharathy")))
+
+;; Format specification for form display
+(setq forms-format-list
+      (append
+       (list "Trimester 2 - Scan Report\n\n")
+       (form-entries
+	'(("IP/OP No" . ip-op-no)
+	  ("Patient Name" . patient-name)
+	  ("Age" . age)
+	  ("Sex" . sex)
+	  ("Visit Date" . visit-date)
+	  ("LMP Date" . lmp-date)
+	  ("LMP EDD" . lmp-edd)))
+       (list "Indications\n" "Growth Scan\n"
+	     "Real time B-mode ultrasonography of gravid uterus done.\n"
+	     "Route: Transabdominal\n" scan "\n\n")
+       (list "Maternal\n")
+       (form-entries
+	'(("Cervix" . maternal-cervix)
+	  ("Internal os" . maternal-internal-os)))
+       (list "Fetal Survey\n")
+       (form-entries
+	'(("Presentation" . survey-presentation)
+	  ("Placenta" . survey-placenta)
+	  ("Liquor" . survey-liquor)
+	  ("Umbilical cord" . survey-umbilical-cord)
+	  ("Fetal activity" . survey-fetal-activity)
+	  ("Cardiac activity" . survey-cardiac-activity)))
+       (list "Fetal Biometry\n")
+       (form-entries
+	'(("BPD" . biometry-bpd)
+	  ("BPD-Age" . biometry-bpd-age)
+	  ("BPD-Percentile" . biometry-bpd-percentile)
+	  ("HC" . biometry-hc)
+	  ("HC-Age" . biometry-hc-age)
+	  ("HC-Percentile" . biometry-hc-percentile)
+	  ("AC" . biometry-ac)
+	  ("AC-Age" . biometry-ac-age)
+	  ("AC-Percentile" . biometry-ac-percentile)
+	  ("FL" . biometry-fl)
+	  ("FL-Age" . biometry-fl-age)
+	  ("FL-Percentile" . biometry-fl-percentile)
+	  ("Estimated fetal weight according to BPD, HC, AC, FL" . biometry-fetal-weight)))
+       (list "Extended Biometry\n")
+       (form-entries
+	'(("Foot Length" . extended-foot-length)
+	  ("TCD" . extended-tcd)))
+       (list "Fetal Anatomy\n")
+       (form-entries
+	'(("Intracranial structures" . anatomy-intracranial)
+	  ("Neck" . anatomy-neck)
+	  ("Spine" . anatomy-spine)
+	  ("Fetal face" . anatomy-face)
+	  ("Both lungs" . anatomy-lungs)
+	  ("Heart" . anatomy-heart)
+	  ("Abdominal situs" . anatomy-abdominal-situs)
+	  ("Both kidneys and bladder" . anatomy-kidneys-bladder)
+	  ("All long bones" . anatomy-long-bones)))
+       (list "Impression\n")
+       (form-entries
+	'(("Gestational age" . impression-gestational-age)
+	  ("Menstrual age" . impression-menstrual-age)
+	  ("Corrected EDD" . impression-corrected-edd)
+	  ("Notes" . impression-notes)
+	  ("Sonologist" . sonologist)))))
+
+(setq form-to-org
+      (lambda ()
+	(with-output-to-string
+	  (make-report-header "OB - 2/3 TRIMESTER SCAN REPORT")
+	  (single-line-org-entries
+	   `(("IP/OP No" . ,ip-op-no)
+	     ("Age" . ,age)
+	     ("Sex" . ,sex)
+	     ("Name of Patient" . ,patient-name)
+	     ("Visit Date" . ,visit-date)
+	     ("LMP Date" . ,lmp-date)
+	     ("LMP EDD" . ,lmp-edd)))
+	  (mapc 'princ `("* Indications\n" "** Target Scan\n"
+			 "Real time B-mode ultrasonography of gravid uterus done.\n\n"))
+	  (single-line-org-entries
+	   `(("Route" . "Transabdominal")))
+	  (princ (get-field scan))
+	  (princ "\n\n* Maternal\n")
+	  (single-line-org-entries
+	   `(("Cervix" . ,maternal-cervix)
+	     ("Internal os" . ,maternal-internal-os)))
+	  (princ "* Fetal Survey\n")
+	  (single-line-org-entries
+	   `(("Presentation" . ,survey-presentation)
+	     ("Placenta" . ,survey-placenta)
+	     ("Liquor" . ,survey-liquor)
+	     ("Umbilical cord" . ,survey-umbilical-cord)
+	     ("Fetal activity" . ,survey-fetal-activity)
+	     ("Cardiac activity" . ,survey-cardiac-activity)))
+	  (princ "* Fetal Biometry\n")
+	  (insert-biometry
+	   `(("BPD" ,biometry-bpd ,biometry-bpd-age ,biometry-bpd-percentile)
+	     ("HC" ,biometry-hc ,biometry-hc-age ,biometry-hc-percentile)
+	     ("AC" ,biometry-ac ,biometry-ac-age ,biometry-ac-percentile)
+	     ("FL" ,biometry-fl ,biometry-fl-age ,biometry-fl-percentile)))
+	  (princ "* Extended Biometry\n")
+	  (single-line-org-entries
+	   `(("Foot Length" . ,extended-foot-length)
+	     ("TCD" . ,extended-tcd)))
+	  (princ "* Fetal Anatomy\n")
+	  (single-line-org-entries
+	   `(("Intracranial structures" . ,anatomy-intracranial)
+	     ("Neck" . ,anatomy-neck)
+	     ("Spine" . ,anatomy-spine)
+	     ("Fetal face" . ,anatomy-face)
+	     ("Both lungs" . ,anatomy-lungs)
+	     ("Heart" . ,anatomy-heart)
+	     ("Abdominal situs" . ,anatomy-abdominal-situs)
+	     ("Both kidneys and bladder" . ,anatomy-kidneys-bladder)
+	     ("All long bones" . ,anatomy-long-bones)))
+	  (princ "* Impression\n")
+	  (princ (format "%s corresponding to a gestational age of %s\n\n"
+			 (get-field scan) (get-field impression-gestational-age)))
+	  (princ "Gestational age assigned as per biometry (CRL)\n\n")
+	  (single-line-org-entries
+	   `(("Menstrual age" . ,impression-menstrual-age)
+	     ("Corrected EDD" . ,impression-corrected-edd)
+	     ("Placenta" . ,survey-placenta)
+	     ("Presentation" . ,survey-presentation)
+	     ("Liquor" . ,survey-liquor)
+	     ("Estimated fetal weight according to BPD, HC, AC, FL" . ,biometry-fetal-weight)))
+	  (text-if-non-blank (get-field impression-notes))
+	  (multi-line-org-entries
+	   `(("Sonologist" . ,sonologist))))))
diff --git a/ksh-scan3.el b/ksh-scan3.el
new file mode 100644
index 0000000..83018c5
--- /dev/null
+++ b/ksh-scan3.el
@@ -0,0 +1,130 @@
+;; -*- lexical-binding: t -*-
+
+(load "ksh-forms-improved.el")
+(load "ksh-report-header.el")
+(load "ksh-biometry.el")
+
+;; Datafile path and fields
+(setq forms-file (expand-file-name "scan3.dat" ksh-data-path))
+(setq forms-number-of-fields
+      (forms-enumerate
+       '(ip-op-no patient-name age sex visit-date lmp-date lmp-edd
+		  scan
+		  survey-presentation survey-placenta survey-liquor
+		  survey-amniotic-fluid-index survey-umbilical-cord
+		  survey-fetal-activity survey-cardiac-activity
+		  survey-fetal-heart-rate
+		  biometry-bpd biometry-bpd-age biometry-bpd-percentile
+		  biometry-hc biometry-hc-age biometry-hc-percentile
+		  biometry-ac biometry-ac-age biometry-ac-percentile
+		  biometry-fl biometry-fl-age biometry-fl-percentile
+		  biometry-fetal-weight
+		  impression-gestational-age impression-menstrual-age
+		  impression-corrected-edd impression-notes
+		  sonologist)))
+
+;; Default values for fields
+(setq default-field-values
+      `((,sex . "F")
+	(,survey-presentation . "cephalic")
+	(,survey-placenta . "posterior")
+	(,survey-liquor . "normal")
+	(,survey-fetal-activity . "normal")
+	(,survey-cardiac-activity . "normal")
+	(,sonologist . "Dr. Bala Bharathy")))
+
+;; Format specification for form display
+(setq forms-format-list
+      (append
+       (list "Trimester 3 - Scan Report\n\n")
+       (form-entries
+	'(("IP/OP No" . ip-op-no)
+	  ("Patient Name" . patient-name)
+	  ("Age" . age)
+	  ("Sex" . sex)
+	  ("Visit Date" . visit-date)
+	  ("LMP Date" . lmp-date)
+	  ("LMP EDD" . lmp-edd)))
+       (list "Indications\n" "Growth Scan\n"
+	     "Real time B-mode ultrasonography of gravid uterus done.\n"
+	     "Route: Transabdominal\n" scan "\n\n")
+       (list "Fetal Survey\n")
+       (form-entries
+	'(("Presentation" . survey-presentation)
+	  ("Placenta" . survey-placenta)
+	  ("Liquor" . survey-liquor)
+	  ("Amniotic fluid index" . survey-amniotic-fluid-index)
+	  ("Umbilical cord" . survey-umbilical-cord)
+	  ("Fetal activity" . survey-fetal-activity)
+	  ("Cardiac activity" . survey-cardiac-activity)
+	  ("Fetal heart rate" . survey-fetal-heart-rate)))
+       (list "Fetal Biometry\n")
+       (form-entries
+	'(("BPD" . biometry-bpd)
+	  ("BPD-Age" . biometry-bpd-age)
+	  ("BPD-Percentile" . biometry-bpd-percentile)
+	  ("HC" . biometry-hc)
+	  ("HC-Age" . biometry-hc-age)
+	  ("HC-Percentile" . biometry-hc-percentile)
+	  ("AC" . biometry-ac)
+	  ("AC-Age" . biometry-ac-age)
+	  ("AC-Percentile" . biometry-ac-percentile)
+	  ("FL" . biometry-fl)
+	  ("FL-Age" . biometry-fl-age)
+	  ("FL-Percentile" . biometry-fl-percentile)
+	  ("Estimated fetal weight according to BPD, HC, AC, FL" . biometry-fetal-weight)))
+       (list "Impression\n")
+       (form-entries
+	'(("Gestational age" . impression-gestational-age)
+	  ("Menstrual age" . impression-menstrual-age)
+	  ("Corrected EDD" . impression-corrected-edd)
+	  ("Notes" . impression-notes)
+	  ("Sonologist" . sonologist)))))
+
+(setq form-to-org
+      (lambda ()
+	(with-output-to-string
+	  (make-report-header "OB - 3/3 TRIMESTER SCAN REPORT")
+	  (single-line-org-entries
+	   `(("IP/OP No" . ,ip-op-no)
+	     ("Age" . ,age)
+	     ("Sex" . ,sex)
+	     ("Name of Patient" . ,patient-name)
+	     ("Visit Date" . ,visit-date)
+	     ("LMP Date" . ,lmp-date)
+	     ("LMP EDD" . ,lmp-edd)))
+	  (mapc 'princ `("* Indications\n" "** Growth Scan\n"
+			 "Real time B-mode ultrasonography of gravid uterus done.\n\n"))
+	  (single-line-org-entries
+	   `(("Route" . "Transabdominal")))
+	  (text-if-non-blank (get-field scan))
+	  (princ "* Fetal Survey\n")
+	  (single-line-org-entries
+	   `(("Presentation" . ,survey-presentation)
+	     ("Placenta" . ,survey-placenta)
+	     ("Liquor" . ,survey-liquor)
+	     ("Amniotic fluid index" . ,survey-amniotic-fluid-index)
+	     ("Umbilical cord" . ,survey-umbilical-cord)
+	     ("Fetal activity" . ,survey-fetal-activity)
+	     ("Cardiac activity" . ,survey-cardiac-activity)
+	     ("Fetal heart rate" . ,survey-fetal-heart-rate)))
+	  (princ "* Fetal Biometry\n")
+	  (insert-biometry
+	   `(("BPD" ,biometry-bpd ,biometry-bpd-age ,biometry-bpd-percentile)
+	     ("HC" ,biometry-hc ,biometry-hc-age ,biometry-hc-percentile)
+	     ("AC" ,biometry-ac ,biometry-ac-age ,biometry-ac-percentile)
+	     ("FL" ,biometry-fl ,biometry-fl-age ,biometry-fl-percentile)))
+	  (princ "* Impression\n")
+	  (princ (format "%s corresponding to a gestational age of %s\n\n"
+			 (get-field scan) (get-field impression-gestational-age)))
+	  (princ "Gestational age assigned as per biometry (CRL)\n\n")
+	  (single-line-org-entries
+	   `(("Menstrual age" . ,impression-menstrual-age)
+	     ("Corrected EDD" . ,impression-corrected-edd)
+	     ("Placenta" . ,survey-placenta)
+	     ("Presentation" . ,survey-presentation)
+	     ("Liquor" . ,survey-liquor)
+	     ("Estimated fetal weight according to BPD, HC, AC, FL" . ,biometry-fetal-weight)))
+	  (text-if-non-blank (get-field impression-notes))
+	  (multi-line-org-entries
+	   `(("Sonologist" . ,sonologist))))))
diff --git a/scan-images.sh b/scan-images.sh
new file mode 100755
index 0000000..b538cae
--- /dev/null
+++ b/scan-images.sh
@@ -0,0 +1,19 @@
+#! /bin/bash -xe
+
+# Query user for directory containing the scan images
+IMAGE_DIRECTORY=$(zenity --file-selection --directory --text="Choose folder with ultrasound images")
+
+# If dialog box was cancelled, exit and do nothing
+if [[ -z $IMAGE_DIRECTORY ]]
+then
+    exit
+fi
+
+IMAGE_FILES=$(ls $IMAGE_DIRECTORY/*.tif)
+IMAGE_WIDTH=$(identify -format "%w" $(ls $IMAGE_DIRECTORY/*.tif | head -n 1))
+MONTAGE_OUTFILE=$(mktemp --suffix=".pdf")
+
+# Create montage of scan images
+montage -geometry $IMAGE_WIDTH -tile 2x3 $IMAGE_FILES $MONTAGE_OUTFILE
+# Send to printer, and delete from memory
+lpr -r -o sides=two-sided-long-edge -o fit-to-page -o page-left=72 -o page-right=72 $MONTAGE_OUTFILE