cloverleaf-larry/lib/nc-tclgen.sh

#!/usr/bin/env bash
# nc-tclgen.sh — generate TCL UPOC scaffolding from intent. Skeletons for
# common Cloverleaf TPS/Xlate use cases. Output is ready-to-edit TCL.
#
# Larry can write your full UPOC for you via prompt; this tool gives you a
# clean, lint-free starting point with the right argument handling and
# boilerplate. Useful when offline or when you want to start from a template.
#
# Subcommands:
#   tps-presc   <proc> [--description TXT]    PreSC TPS proc skeleton
#   tps-postsc  <proc> [--description TXT]    PostSC TPS proc skeleton
#   tps-iclkill <proc> [--description TXT]    a proc that calls hcitpsmsgkill
#   xlate-helper <proc> [--description TXT]   xlate helper function skeleton
#   trxid       <proc> [--description TXT]    trxid (routing key) extractor
#   ack         <proc> [--description TXT]    raw ACK generator
#   field-rewrite <proc> --segment SEG --field N --to VALUE   small field setter
#   list-templates
#
# Output: TCL source to stdout (or --out PATH).
set -o pipefail

usage() { sed -n '2,20p' "$0"; exit 0; }
die() { printf 'nc-tclgen: %s\n' "$*" >&2; exit 1; }

header() {
  local proc="$1" desc="$2" template="$3"
  cat <<EOF
########################################################################
# $proc — $desc
#
# Cloverleaf UPOC: $template
# Generated by larry-anywhere nc-tclgen.sh on $(date -Iseconds 2>/dev/null || date)
# Author: ${USER:-larry-anywhere}
########################################################################

EOF
}

emit_tps_presc() {
  local proc="$1" desc="${2:-PreSC handler — runs before service send}"
  header "$proc" "$desc" "PreSC"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args

    keylget args MODE mode
    keylget args MSGID mid

    switch -- \$mode {
        start  { return "" }
        run {
            # Get the message data
            set hl7Data [keylget args MSGDATA]

            # TODO: inspect or transform \$hl7Data
            # Example: strip CR/LF from segment delimiters
            # regsub -all {\r|\n} \$hl7Data " " hl7Data

            # Put the (possibly modified) message back into args
            keylset args MSGDATA \$hl7Data

            return { { CONTINUE } }
        }
        time   { return "" }
        shutdown { return "" }
        default { return "" }
    }
}
EOF
}

emit_tps_postsc() {
  local proc="$1" desc="${2:-PostSC handler — runs after route translation}"
  header "$proc" "$desc" "PostSC"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args

    keylget args MODE mode
    keylget args MSGID mid

    switch -- \$mode {
        start  { return "" }
        run {
            set hl7Data [keylget args MSGDATA]

            # TODO: post-xlate processing
            # Example: log message control ID
            # set msh [lindex [split \$hl7Data "\r"] 0]
            # set ctlId [lindex [split \$msh "|"] 9]
            # echo "post-xlate \$proc: ctlId=\$ctlId"

            keylset args MSGDATA \$hl7Data
            return { { CONTINUE } }
        }
        time   { return "" }
        shutdown { return "" }
        default { return "" }
    }
}
EOF
}

emit_tps_iclkill() {
  local proc="$1" desc="${2:-Drop message based on condition}"
  header "$proc" "$desc" "PreSC (kills msg conditionally)"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args
    keylget args MODE mode
    switch -- \$mode {
        start  { return "" }
        run {
            set hl7Data [keylget args MSGDATA]

            # TODO: decide whether to drop. Return KILL to drop, CONTINUE to keep.
            # Example: drop if PID-18 (account) is empty.
            set segs [split \$hl7Data "\r"]
            foreach s \$segs {
                if {[string match "PID|*" \$s]} {
                    set fields [split \$s "|"]
                    if {[lindex \$fields 18] eq ""} {
                        echo "$proc: dropping message — empty PID.18"
                        return { { KILL } }
                    }
                }
            }
            return { { CONTINUE } }
        }
        default { return "" }
    }
}
EOF
}

emit_xlate_helper() {
  local proc="$1" desc="${2:-Xlate helper function}"
  header "$proc" "$desc" "Xlate proc"
  cat <<EOF
# Xlate-callable helper. Use in an Xlate via:
#   { OP COPY } { IN =[proc $proc {input}] } { OUT 0(0).PID(0).#X }
proc $proc {input} {
    # TODO: transform \$input into the desired output value.
    # Examples:
    #   - Uppercase: return [string toupper \$input]
    #   - Default fallback: if {\$input eq ""} { return "UNKNOWN" } else { return \$input }
    #   - Table lookup: return [tablelookup my_table_name \$input]
    return \$input
}
EOF
}

emit_trxid() {
  local proc="$1" desc="${2:-Routing-key extractor (returns trxid for routes)}"
  header "$proc" "$desc" "TRXID (DATAFORMAT.PROC)"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args
    keylget args MSGDATA hl7Data

    # TODO: return a string that route-conditions will match (TRXID regex).
    # Common pattern: combine MSH.9 event + a tag from PID/PV1.
    set segs [split \$hl7Data "\r"]
    set msh  [lindex \$segs 0]
    set mshFields [split \$msh "|"]
    set msgType   [lindex \$mshFields 8]   ;# MSH.9 (ADT^A08)

    # Example: include receiving facility (PV1.4) or patient class
    set trxid "\$msgType"

    keylset args TRXID \$trxid
    return { { CONTINUE } }
}
EOF
}

emit_ack() {
  local proc="$1" desc="${2:-Generate a raw ACK (AA) for the inbound message}"
  header "$proc" "$desc" "ACK generator"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args
    keylget args MSGDATA hl7Data

    set segs [split \$hl7Data "\r"]
    set msh  [lindex \$segs 0]
    set mshFields [split \$msh "|"]
    set sendingApp   [lindex \$mshFields 2]
    set sendingFac   [lindex \$mshFields 3]
    set receivingApp [lindex \$mshFields 4]
    set receivingFac [lindex \$mshFields 5]
    set ctlId        [lindex \$mshFields 9]

    set ts [clock format [clock seconds] -format "%Y%m%d%H%M%S"]
    set ackMsh "MSH|^~\\\\&|\$receivingApp|\$receivingFac|\$sendingApp|\$sendingFac|\$ts||ACK|\$ctlId|P|2.3"
    set ackMsa "MSA|AA|\$ctlId"
    set ack    "\$ackMsh\r\$ackMsa\r"

    keylset args MSGDATA \$ack
    return { { CONTINUE } }
}
EOF
}

emit_field_rewrite() {
  local proc="$1" seg="$2" fnum="$3" to="$4"
  local desc="Set $seg.$fnum to '$to' on every message"
  header "$proc" "$desc" "PreSC field rewrite"
  cat <<EOF
proc $proc {dArgs} {
    upvar 1 \$dArgs args
    keylget args MODE mode
    if {\$mode ne "run"} { return "" }

    set hl7Data [keylget args MSGDATA]
    set segs    [split \$hl7Data "\r"]
    set newSegs {}
    foreach s \$segs {
        if {[string match "$seg|*" \$s]} {
            set fields [split \$s "|"]
            # $seg.\$fnum maps to list-index N (HL7 segment numbering)
            set fields [lreplace \$fields $fnum $fnum "$to"]
            set s [join \$fields "|"]
        }
        lappend newSegs \$s
    }
    keylset args MSGDATA [join \$newSegs "\r"]
    return { { CONTINUE } }
}
EOF
}

list_templates() {
  cat <<EOF
Templates:
  tps-presc       PreSC handler skeleton
  tps-postsc      PostSC handler skeleton
  tps-iclkill     Conditional message drop
  xlate-helper    Xlate-callable helper function
  trxid           Routing key extractor
  ack             Raw ACK generator
  field-rewrite   Set a specific field to a constant on every message
EOF
}

SUB="${1:-help}"
shift 2>/dev/null

OUT_FILE=""
PROC=""
DESC=""
SEG=""; FNUM=""; TO=""

# Parse common flags
while [ $# -gt 0 ]; do
  case "$1" in
    --description) shift; DESC="$1" ;;
    --out)         shift; OUT_FILE="$1" ;;
    --segment)     shift; SEG="$1" ;;
    --field)       shift; FNUM="$1" ;;
    --to)          shift; TO="$1" ;;
    -h|--help)     usage ;;
    -*)            die "unknown flag: $1" ;;
    *)             [ -z "$PROC" ] && PROC="$1" || die "extra arg: $1" ;;
  esac
  shift
done

run_emit() {
  if [ -n "$OUT_FILE" ]; then
    mkdir -p "$(dirname "$OUT_FILE")" 2>/dev/null
    "$@" > "$OUT_FILE"
    printf 'wrote %s\n' "$OUT_FILE" >&2
  else
    "$@"
  fi
}

case "$SUB" in
  tps-presc)     [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_tps_presc "$PROC" "$DESC" ;;
  tps-postsc)    [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_tps_postsc "$PROC" "$DESC" ;;
  tps-iclkill)   [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_tps_iclkill "$PROC" "$DESC" ;;
  xlate-helper)  [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_xlate_helper "$PROC" "$DESC" ;;
  trxid)         [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_trxid "$PROC" "$DESC" ;;
  ack)           [ -n "$PROC" ] || die "needs PROC name"; run_emit emit_ack "$PROC" "$DESC" ;;
  field-rewrite) [ -n "$PROC" ] && [ -n "$SEG" ] && [ -n "$FNUM" ] && [ -n "$TO" ] \
                   || die "needs PROC + --segment SEG --field N --to VALUE"
                 run_emit emit_field_rewrite "$PROC" "$SEG" "$FNUM" "$TO" ;;
  list-templates|list) list_templates ;;
  help|-h|--help)      usage ;;
  *)                   die "unknown subcommand: $SUB" ;;
esac