PK.DAEMON
X(%PK.ERROR),
@PK.INIT,
@PK.LOADCONFIG,
IF{"PROTOCOL"=/cmd "MP1"_D(10)_D(13)^!,""^/RECUSED;
   "READ"=/cmd @PK.READ;
   "WRITE"=/cmd @PK.WRITE;
   "TRANS"=/cmd @PK.TRANS;
   "LIST"=/cmd @PK.LIST;
   "VERSION"=/cmd @PK.VERSION;
   "CLEARCONFIG"=/cmd @PK.CLEARCONFIG;
   "VALIDATECONFIG"=/cmd @PK.VALIDATECONFIG;
   "SETCONFIG"=/cmd @PK.SETCONFIG;
   1^nocmd},
IF{nocmd ""^nocmd,
   IF{'/VALIDCONF 1,
      "Configuration file not validated, cannot proceed."_D(13)_D(10)^!;
      IF{"LABSET"=/cmd %PK.LABSET(/ARGV[1]);
         " The following two lines filter all but capital letters ",
         " and digits out of the command string, so commands may ",
         " not contain any punctuation or lower case. ",
         D(255):48_"0123456789"_(D(255):7)_"ABCDEFGHIJKLMNOPQRSTUVWXYZ"_(D(255):164)^/filter,
         /cmd'~/filter^/cmd,
         "%PK."_/cmd^fname,V("O(&,"_fname_")") C(&),V(fname_"(0)");
         "unknown request: "_/cmd_D(13)_D(10)^!}}},
IF{/RECUSED&/RECOVERFLOW 1,
   "<Overflow> > 255 chars in arg list </Overflow>"^!},
@DEBUG.CLEANUP,
END;

PK.INIT
O(/,"P"),
@DEBUG.STARTUP,
10^!S,
!6^start,
IF{start'="_PKB_|" 1,
   "Invalid command (received "_start_")"^/error,
   /error_D(10)_D(13)^!,
   @DEBUG.BADCALL(/error),
   @DEBUG.CLEANUP,
   H(0)},
1^running,
0^nr,
DO{O(!)&running 1,
   !^line,
   !2,
   0^i,
   "0|"^is,
   DO{line#is 1,
      (line#is):0X:0S^/ARGV[nr],
      i+1^i,
      i_"|"^is,
      nr+1^nr},
   IF{nr-1<0 ""^running;
      /ARGV[nr-1]="_PKE_" ""^running}},
""^line,
nr-1^/ARGC,
""^/ARGV[/ARGC],"Clear out PKE",
/ARGV[0]^/cmd,
/ARGV[0]^/REC,0^i,
DO{i+1^i,(i</ARGC)&((L(/REC)+L(/ARGV[i]))<254) /REC_"|"_/ARGV[i]^/REC},
IF{i</ARGC 1^/RECOVERFLOW},
"toward removing RECUSED, changed default",""^/RECUSED,
@DEBUG.LOG(CMD,/REC)

; Set up option list to help us verify both validity and completeness
; of config options.
PK.CONFIGTEMPLATE
K(/OPTIONS),
0^v,
Q(.labs.source,..labs.nostatus,..oe.allow.drafts)^/V[1+v^v],
Q(..notes.depts,..notes.nursing.cats,..orders.cats)^/V[1+v^v],
Q(.login.encrypt)^/V[1+v^v],
Q(.results.source,..results.depts)^/V[1+v^v],
Q(..results.path.nostatus,..results.micro.nostatus)^/V[1+v^v],
Q(..results.rad.nostatus)^/V[1+v^v],
Q(.patdoc.providerarg,.patient.locationfiltering)^/V[1+v^v],
Q(.patient.outpat.exp)^/V[1+v^v],
Q(.patient.scheduledrelsonly)^/V[1+v^v],
Q(.uselab,.usemocklab,.usemri,.usemsm,.usenur,.useoe)^/V[1+v^v],
Q(.usepha,.userad,.usesch,.usepci)^/V[1+v^v],
Q(..vitals.queries,.vitals.bp.query)^/V[1+v^v],
Q(..ios.additional.intake.queries,..ios.additional.output.queries)^/V[1+v^v],
Q(..ios.not.accumulable,..ios.remove.prefixes)^/V[1+v^v],
""^v,
DO{>/V[v]^v @PK.TEMPLINE},
K(/V),
""^i

; Names with an extra leading . (..) are taken to be vectors (putting
; | delimited words into a subnode); otherwise they are strings
PK.TEMPLINE
0^i,
DO{/V[v]|i^opt 1,
   IF{L(opt,..)=0 1,
      opt%0^opt,
      "vector"^typ;
      "string"^typ},
   typ^/OPTIONS[opt],
   1+i^i},
""^i,
""^typ,
""^opt

PK.VALIDATECONFIG
@PK.CONFIGTEMPLATE,
O(*,%pkconfig),
""^opt,
; Verify everything in config file should be there.
DO{>*OPTIONS[opt]^opt 1,
   IF{/OPTIONS[opt]^typ 1,
      IF{typ'=*OPTIONS[opt] 1,
         "type mismatch: "_opt_D(13)_D(10)^!,
         1^badness};
      "unknown config option: "_opt_D(13)_D(10)^!,
      1^badness}},
; Verify everthing that should be loaded, is.
DO{>/OPTIONS[opt]^opt 1,
   IF{'*OPTIONS[opt] 1,
      "unset config option: "_opt_" (type "_/OPTIONS[opt]_")"_D(13)_D(10)^!,
      1^badness}},
IF{badness 1,
   ""^*VALIDCONF,
   "*** Errors in configuration file; fix before continuing."^!;
   "ok"^*VALIDCONF,
   "*** Configuration is good."^!},
C(*)

PK.CLEARCONFIG
""^/RECUSED,
O(*,%pkconfig),
K(*CONF),
K(*OPTIONS),
""^*VALIDCONF,
C(*),
"Configuration cleared."_D(13)_D(10)^!

PK.LOADCONFIG
""^/RECUSED,
IF{'%pkconfig 1,
   A(1,%pkconfig)},
O(*,%pkconfig),
M(*CONF,/CONF),
*VALIDCONF^/VALIDCONF,
C(*)

PK.SETCONFIG
""^/RECUSED,
@PK.CONFIGTEMPLATE,
/ARGV[1]^opt,
/OPTIONS[opt]^typ,
IF{'typ "unknown option: "_opt^!,"string"^typ;
   "accepted "_opt_", type "_typ^!},
O(*,%pkconfig),
typ^*OPTIONS[opt],
IF{typ="vector" 2^nr,
     K(*CONF[opt]),
     DO{nr</ARGC 1,
        1^*CONF[opt][/ARGV[nr]],
        1^*CONF[opt],"serves as simple not-nil flag for vector",
        nr+1^nr};
   typ="string" 1,
     IF{/ARGC>2 /ARGV[2]^*CONF[opt];
        ""^*CONF[opt]}},
C(*)

PK.READ
""^/RECUSED,
/ARGV[1]^filename,
O(*,%.MACRO),
O(:,*M[filename])^op,
IF{'op O(:,*S[filename])^op},
IF{op DO{+: :_D(13)_D(10)^!};"file "_filename_" not found"^!}

PK.WRITE
""^/RECUSED,
/ARGV[1]^filename,
/ARGV[2]^type,
O(*,%.MACRO),
IF{type="MACROS" O(:,*M[filename])^op,
IF{'op A(0,*M[filename]),O(:,*M[filename])^op}},
IF{type="PROGRAM" O(:,*S[filename])^op,
IF{'op A(0,*S[filename]),O(:,*S[filename])^op}},
1^going,
IF{op DO{going !^line,
IF{line="END_OF_PROGRAM" "success "_filename_" "_type^!,
""^going,C(:);line^:,!2}};"couldn't write file"^!}

PK.TRANS
""^/RECUSED,
/ARGV[1]^filename,
/ARGV[2]^type,
O(&,%.MACRO),
O(*,0S),
IF{$.TEMP[*["J"]]T 1,
   F($.TEMP[*["J"]]T)},
O(*,A(1,$.TEMP[*["J"]]T)),
IF{type="MACROS" &M[filename]^*M[filename],1^*flag;
   type="PROGRAM" &S[filename]^*P[filename];
   type="ALL" ""^filename,
   1^*flag,
   DO{>&M[filename]^filename 1,
      &M[filename]^*M[filename]},
   ""^filename,
   DO{>&S[filename]^filename 1,
      IF{filename'="PK.DAEMON" 1,
         &S[filename]^*P[filename]}}},
Q($,%,*)^sv,C(*),
J($T.BGT,sv,"PKAUTOTRANS","N","N")^J,
IF{$.TEMP[J]T 1,
   F($.TEMP[J]T)},
O(*,0S),
R($.TEMP[*["J"]]T,$.TEMP[J]T),
O(*,$.TEMP[J]T),
W(*["RENAME"]),
C(*),
"translation initiated"_D(13)_D(10)^!,
IF{(type'="PROGRAM")!(filename'="PK.DAEMON") 1,
   H(1),
   O(?,&TABLE),
   0^cnt,
   DO{(cnt<20)&?BGTM["PKAUTOTRANS"] 1,
      "translation in progress"_D(13)_D(10)^!,
      1+cnt^cnt,
      H(5)},
   IF{cnt=10 1,
      "translation still running, stopping poll; "^!,
      "output may be incomplete"_D(13)_D(10)^!;
      "translation complete"_D(13)_D(10)^!},
   O(:,%.MACRO.OP["PKAUTOTRANS"])^op,
   IF{op 1,
      DO{+: :^!};
      "translation output not found"_D(13)_D(10)^!}}

PK.LIST
""^/RECUSED,
O(*,%.MACRO),
""^l,
DO{>*M[l]^l l~$U.TO.L_".txt "_l_" MACROS"_D(13)_D(10)^!},
""^l,
DO{>*S[l]^l l~$U.TO.L_".txt "_l_" PROGRAM"_D(13)_D(10)^!}

PK.VERSION
""^/RECUSED,
"$Name:  $"^!

; Debugging globals:
;   /job - job number
;   /trans - current transaction number
;   /haveslot - allowed to write debug info
DEBUG.STARTUP
@DEBUG.INITFILE,
O(*,0S),
*["J"]^/job,
C(*),
O(#,%pkdebug),
W(#LOCK),
#trans+1^#trans^/trans,
IF{#slotsused<20 1,
   #slotsused+1^#slotsused,
   1^/haveslot,
   /job^#LOG[/trans]JOB;
   ""^/haveslot},  
R(#LOCK),
C(#)

DEBUG.BADCALL
O(#,%pkdebug),
W(#LOCK),
#badcalls+1^#badcalls,
@1^#lastbadcall,
R(#LOCK),
C(#)

DEBUG.LOG
IF{/haveslot 1,
   O(#,%pkdebug),
   @2^#LOG[/trans]@1,
   C(#)}

DEBUG.CLEANUP
IF{/haveslot 1,
   O(#,%pkdebug),"testing",
   W(#LOCK),
   #slotsused-1^#slotsused,
   K(#LOG[/trans]),
   R(#LOCK),
   C(#)}

DEBUG.INITFILE
IF{'%pkdebug 1,
   A(1,%pkdebug),
   O(#,%pkdebug),
   W(#LOCK),
   0^#trans,
   0^#slotsused,
   0^#badcalls,
   R(#LOCK),
   C(#)}
