| 1 | TMGQIO ;TMG/kst/Quiet IO routines ;03/25/06
 | 
|---|
| 2 |         ;;1.0;TMG-LIB;**1**;11/01/04
 | 
|---|
| 3 | 
 | 
|---|
| 4 |  ;"'QUIET IO   To provide routines for quite (non-interactive) IO that programs can call.
 | 
|---|
| 5 |  ;"=============================================================================
 | 
|---|
| 6 |  ;"Kevin Toppenberg, MD  11-04
 | 
|---|
| 7 |  ;"
 | 
|---|
| 8 |  ;"'QUIET IO"
 | 
|---|
| 9 |  ;"
 | 
|---|
| 10 |  ;"Purpose:
 | 
|---|
| 11 |  ;"  To provide routines for quite (non-interactive) IO that programs can call.
 | 
|---|
| 12 |  ;"     i.e. replacement routines for READ and WRITE
 | 
|---|
| 13 |  ;"
 | 
|---|
| 14 |  ;"Functions:
 | 
|---|
| 15 |  ;"  OUTP(SILENT,A,B,C,D,E,F,G,H,I,J)
 | 
|---|
| 16 |  ;"  WOUT(S)
 | 
|---|
| 17 |  ;"  SILENTW(S) -- puts output into INFO("TEXT")
 | 
|---|
| 18 |  ;"  INP(VAR,SILENT,TIMEOUT,SILNTVAL,A,B,C,D,E,F,G,H,I,J)
 | 
|---|
| 19 |  ;"
 | 
|---|
| 20 |  ;"Dependancies:
 | 
|---|
| 21 |  ;"  if TMGDEBUG defined, then requires TMGDEBUG.m
 | 
|---|
| 22 |  ;"=============================================================================
 | 
|---|
| 23 | 
 | 
|---|
| 24 | OUTP(SILENT,A,B,C,D,E,F,G,H,I,J)
 | 
|---|
| 25 |   ;"Purpose: To provide an output channel for this program module.  Will allow
 | 
|---|
| 26 |   ;"    converting to a "SILENT-OUTPUT" mode.
 | 
|---|
| 27 |   ;
 | 
|---|
| 28 |   ;"IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"OUTP^TMGQIO")
 | 
|---|
| 29 |   IF $GET(SILENT,0)=1 DO  GOTO OPQUIT
 | 
|---|
| 30 |   . IF '$$SILENTW(.A) QUIT
 | 
|---|
| 31 |   . IF '$$SILENTW(.B) QUIT
 | 
|---|
| 32 |   . IF '$$SILENTW(.C) QUIT
 | 
|---|
| 33 |   . IF '$$SILENTW(.D) QUIT
 | 
|---|
| 34 |   . IF '$$SILENTW(.E) QUIT
 | 
|---|
| 35 |   . IF '$$SILENTW(.F) QUIT
 | 
|---|
| 36 |   . IF '$$SILENTW(.G) QUIT
 | 
|---|
| 37 |   . IF '$$SILENTW(.H) QUIT
 | 
|---|
| 38 |   . IF '$$SILENTW(.I) QUIT
 | 
|---|
| 39 |   . IF '$$SILENTW(.J) QUIT
 | 
|---|
| 40 |   ELSE  DO  GOTO OPQUIT
 | 
|---|
| 41 |   . IF '$$WOUT(.A) QUIT
 | 
|---|
| 42 |   . IF '$$WOUT(.B) QUIT
 | 
|---|
| 43 |   . IF '$$WOUT(.C) QUIT
 | 
|---|
| 44 |   . IF '$$WOUT(.D) QUIT
 | 
|---|
| 45 |   . IF '$$WOUT(.E) QUIT
 | 
|---|
| 46 |   . IF '$$WOUT(.F) QUIT
 | 
|---|
| 47 |   . IF '$$WOUT(.G) QUIT
 | 
|---|
| 48 |   . IF '$$WOUT(.H) QUIT
 | 
|---|
| 49 |   . IF '$$WOUT(.I) QUIT
 | 
|---|
| 50 |   . IF '$$WOUT(.J) QUIT
 | 
|---|
| 51 |   ;
 | 
|---|
| 52 | OPQUIT
 | 
|---|
| 53 |   ;"IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"OUTP^TMGQIO")
 | 
|---|
| 54 |   QUIT
 | 
|---|
| 55 |   ;
 | 
|---|
| 56 |   ;
 | 
|---|
| 57 | WOUT(S)
 | 
|---|
| 58 |   ;"Purpose: To write out S, or newline if "!" passed
 | 
|---|
| 59 |   ;"Result: 1 if text output, 0 if it wasn't
 | 
|---|
| 60 |   ;
 | 
|---|
| 61 |   ;"IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"WOUT^TMGQIO")
 | 
|---|
| 62 |   ;"IF $GET(TMGDEBUG)>0 DO DebugMsg^TMGDEBUG(.DBIndent,"S='",$GET(S),"'")
 | 
|---|
| 63 |   NEW RESULT SET RESULT=0
 | 
|---|
| 64 |   IF $DATA(S)'=0 DO
 | 
|---|
| 65 |   . SET RESULT=1
 | 
|---|
| 66 |   . IF S="!" WRITE ! QUIT
 | 
|---|
| 67 |   . IF ($EXTRACT(S,1)="?")&(+$EXTRACT(S,2,256)>0) DO
 | 
|---|
| 68 |   . . NEW INDENT,I
 | 
|---|
| 69 |   . . SET INDENT=+$EXTRACT(S,2,256)
 | 
|---|
| 70 |   . . FOR I=1:1:INDENT WRITE " "
 | 
|---|
| 71 |   . ELSE  WRITE S
 | 
|---|
| 72 |   ;"IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"WOUT^TMGQIO")
 | 
|---|
| 73 |   QUIT RESULT
 | 
|---|
| 74 |   ;
 | 
|---|
| 75 |   ;
 | 
|---|
| 76 | SILENTW(S)
 | 
|---|
| 77 |   ;"Purpose: To take text and put in INFO Array
 | 
|---|
| 78 |   ;"Result: 1 if text output, 0 if it wasn't
 | 
|---|
| 79 |   ;
 | 
|---|
| 80 |  IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"SILENTW^TMGQIO")
 | 
|---|
| 81 |  NEW RESULT SET RESULT=0
 | 
|---|
| 82 |  IF $DATA(S)=0 GOTO SWQ
 | 
|---|
| 83 |  NEW LINE
 | 
|---|
| 84 |  SET LINE=$get(INFO("TEXT","LINES"),1)
 | 
|---|
| 85 |  DO DebugMsg^TMGDEBUG(.DBIndent,"s=",S)
 | 
|---|
| 86 |  IF S="!" DO
 | 
|---|
| 87 |  . IF $DATA(INFO("TEXT",LINE))=0 SET INFO("TEXT",LINE)=" "
 | 
|---|
| 88 |  . SET INFO("TEXT","LINES")=LINE+1
 | 
|---|
| 89 |  ELSE  DO
 | 
|---|
| 90 |  . IF $EXTRACT(S,1)="?" set S="" ;"Ignore ?x's
 | 
|---|
| 91 |  . SET INFO("TEXT",LINE)=$get(INFO("TEXT",LINE)," ")_S
 | 
|---|
| 92 |  SET RESULT=1
 | 
|---|
| 93 | SWQ
 | 
|---|
| 94 |  IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"SILENTW^TMGQIO")
 | 
|---|
| 95 |  QUIT RESULT
 | 
|---|
| 96 |  ;
 | 
|---|
| 97 |  ;
 | 
|---|
| 98 | INP(VAR,SILENT,TIMEOUT,SILNTVAL,A,B,C,D,E,F,G,H,I,J)
 | 
|---|
| 99 |         ;"Purpose: To provide an input that may or may not be silent
 | 
|---|
| 100 |         ;"Input VAR: variable to input. SHOULD PASS BY REFERENCE
 | 
|---|
| 101 |         ;"      SILENT: 1=silent (will get value from SILNTVAL), 0=interactive
 | 
|---|
| 102 |         ;"      TIMEOUT: value to timeout user input (optional, will default to 120)
 | 
|---|
| 103 |         ;"      SILNTVAL: the value to use to assign VAR if SILENT=1
 | 
|---|
| 104 |         ;"      A..J: optional prompts for input if not in silent mode
 | 
|---|
| 105 |  IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"INP^TMGQIO")
 | 
|---|
| 106 | 
 | 
|---|
| 107 |  SET SILENT=$get(SILENT,0)
 | 
|---|
| 108 |  IF SILENT=1 DO
 | 
|---|
| 109 |  . SET VAR=$get(SILNTVAL)
 | 
|---|
| 110 |  . IF $GET(TMGDEBUG)>0 DO DebugMsg^TMGDEBUG(.DBIndent,"Silent input used=",VAR)
 | 
|---|
| 111 |  . DO OUTP(SILNTOUT,VAR,"!") ;//to show log the value used.
 | 
|---|
| 112 |  ELSE  DO
 | 
|---|
| 113 |  . DO OUTP(SILNTOUT,.A,.B,.C,.D,.E,.F,.G,.H,.I,.J)
 | 
|---|
| 114 |  . SET TIMEOUT=$get(TIMEOUT,120)
 | 
|---|
| 115 |  . READ VAR:TIMEOUT
 | 
|---|
| 116 |  . DO OUTP(SILNTOUT,"!")
 | 
|---|
| 117 |  ;
 | 
|---|
| 118 |  IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"INP^TMGQIO")
 | 
|---|
| 119 |  QUIT
 | 
|---|
| 120 |  ;
 | 
|---|
| 121 |  ;
 | 
|---|