source: cprs/branches/tmg-cprs/m_files/TMGQIO.m

Last change on this file was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 3.8 KB
Line 
1TMGQIO ;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
24OUTP(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 ;
52OPQUIT
53 ;"IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"OUTP^TMGQIO")
54 QUIT
55 ;
56 ;
57WOUT(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 ;
76SILENTW(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
93SWQ
94 IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"SILENTW^TMGQIO")
95 QUIT RESULT
96 ;
97 ;
98INP(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 ;
Note: See TracBrowser for help on using the repository browser.