[796] | 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 | ;
|
---|