source: FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSFMN0.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1HLCSFMN0 ;ALB/JRP - INCOMING/OUTGOING FILER MONITOR;19-MAY-95 ;10/15/99 06:57
2 ;;1.6;HEALTH LEVEL SEVEN;**15,57**;Oct 13, 1995
3HEADER(FLRTYPE) ;Display column header
4 ;INPUT : FLRTYPE - Flag indicating type of filer header is for
5 ; IN = Incoming filer (default)
6 ; OUT = Outgoing filer
7 ; The following screen attributes:
8 ; IOELEOL, IOUON, IOUOFF
9 ;OUTPUT : None
10 ;NOTES : Existance of IOUON & IOUOFF is assumed
11 ; : Header begins on current line (i.e. calling application
12 ; must put cursor at beginning of line)
13 ; : Cursor will be put at the beginning of line after header
14 ; when completed
15 ;
16 ;Check input
17 N X S X=0 X ^%ZOSF("RM")
18 ;Turn off terminal line wrap
19 S FLRTYPE=$G(FLRTYPE)
20 N WHTESPCE,DASHES
21 ;Set whitespace between columns
22 S WHTESPCE=$J(" ",3)
23 ;Convert filer type to long format
24 S FLRTYPE=$S(FLRTYPE="OUT":"Outgoing",1:"Incoming")
25 ;Print column headers
26 W "Task Number of ",WHTESPCE,"Asked"
27 W IOELEOL,!
28 W IOUON,FLRTYPE," Filer ",IOUOFF,WHTESPCE
29 W IOUON,"To Stop",IOUOFF,WHTESPCE
30 W IOUON,"Last Known Date/Time",IOUOFF,WHTESPCE
31 W IOUON,"Time Difference",$J(" ",13),IOUOFF
32 W IOELEOL,!
33 ;Screen attributes have no value - print dashes
34 I ((IOUON'="")&(IOUOFF'="")) S X=IOM X ^%ZOSF("RM") QUIT
35 ;Turn terminal line wrap back on
36 ;Set longest set of dashes used
37 S DASHES=$TR($J(" ",28)," ","-")
38 ;Print dashes
39 W $E(DASHES,1,15),WHTESPCE,$E(DASHES,1,7),WHTESPCE
40 W $E(DASHES,1,20),WHTESPCE,DASHES
41 W IOELEOL,!
42 S X=IOM X ^%ZOSF("RM")
43 ;Turn terminal line wrap back on
44 Q
45PROMPT() ;Prompt user for action and execute the selected action
46 ;INPUT : INFILER(PtrSubEntry) = TaskNumber ^ Last$H ^ StopFlag ^
47 ; Printable$H ^ ErrorMessage
48 ; OUTFILER(PtrSubEntry) = TaskNumber ^ Last$H ^ StopFlag ^
49 ; Printable$H ^ ErrorMessage
50 ; PtrSubEntry = Pointer to subentry in file 869.3
51 ; TaskNumber = Task number of filer
52 ; Last$H = Last known $H (field #.03 of subentry)
53 ; StopFlag = Whether or not filer has been asked to stop
54 ; (field #.02 of subentry)
55 ; Yes - Filer has been asked to stop
56 ; No - Filer has not been asked to stop
57 ; Error - Task stopped due to error
58 ; Printable$H = Last$H in printable format
59 ; ErrorMessage = Printable error message - only used when
60 ; task stopped due to error
61 ; INTOP = Pointer to first incoming filer in list to display
62 ; OUTTOP = Pointer to first outgoing filer in list to display
63 ; The following screen attributes
64 ; IOINORM, IOINHI, IOELEOL
65 ;OUTPUT : 0 = User didn't choose to quit
66 ; 1 = User choose to quit
67 ; INTOP & OUTTOP will be adjusted accordingly
68 ; NEXT action - INTOP & OUTTOP will be moved down 4 entries
69 ; in the list. If the end of a list is
70 ; reached, INTOP/OUTTOP will be set to the
71 ; last entry in the list.
72 ; BACKUP action - INTOP & OUTTOP will be moved up 4 entries
73 ; in the list. If the top of a list is
74 ; reached, INTOP/OUTTOP will be set to the
75 ; first entry in the list.
76 ; START actions - INTOP & OUTTOP will not be changed
77 ; STOP actions - INTOP & OUTTOP will not be changed
78 ; DELETE actions - INTOP & OUTTOP will not be changed
79 ;NOTES : Prompt will be displayed at current cursor position
80 ; : All input is assumed
81 ; : When the STOP action is choosen, the first filer in the
82 ; list of filers will be stopped
83 ;
84 ;Declare variables
85 N ANS,ANS1,LOOP,TMP,ARRAYREF,TMPARR,NEWTOP
86 ;Turn off terminal line wrap
87 N X S X=0 X ^%ZOSF("RM")
88 ;Display prompt
89 W "(",IOINHI,"+I",IOINORM,") Start incoming filer "
90 W "(",IOINHI,"-I",IOINORM,") Stop incoming filer "
91 W "(",IOINHI,"*I",IOINORM,") Delete incoming filer"
92 W IOELEOL,!
93 W "(",IOINHI,"+O",IOINORM,") Start outgoing filer "
94 W "(",IOINHI,"-O",IOINORM,") Stop outgoing filer "
95 W "(",IOINHI,"*O",IOINORM,") Delete outgoing filer"
96 W IOELEOL,!
97 W " (",IOINHI,"N",IOINORM,") Next 4 lines in list "
98 W " (",IOINHI,"B",IOINORM,") Back 4 lines in list "
99 W " (",IOINHI,"Q",IOINORM,") Quit"
100 W IOELEOL,!
101 W "Type selection: ",IOELEOL
102 ;Get users response
103 R ANS#1:5 Q:('$T) 0
104 ;User hit <RET>
105 Q:(ANS="") 0
106 ;User choose to quit
107 I ("Qq^"[ANS) D Q 1
108 .;Echo rest of response
109 .W:(ANS="Q") "UIT"
110 .W:(ANS="q") "uit"
111 .W:(ANS="^") " QUIT"
112 .H 1
113 ;NEXT action
114 I ("Nn"[ANS) D Q 0
115 .;Echo rest of response
116 .W:(ANS="N") "EXT"
117 .W:(ANS="n") "ext"
118 .H 1
119 .F ARRAYREF="INFILER","OUTFILER" D
120 ..;Move down 4 entries in list
121 ..S NEWTOP=$S(ARRAYREF="INFILER":INTOP,1:OUTTOP)
122 ..F LOOP=1:1:4 S NEWTOP=+$O(@ARRAYREF@(NEWTOP)) Q:('NEWTOP)
123 ..;Went past bottom of list - set to last entry in list
124 ..I ('NEWTOP) S NEWTOP="" S NEWTOP=+$O(@ARRAYREF@(NEWTOP),-1)
125 ..;Save new value into appropriate variable
126 ..S:(ARRAYREF="INFILER") INTOP=NEWTOP
127 ..S:(ARRAYREF="OUTFILER") OUTTOP=NEWTOP
128 ;BACKUP action
129 I ("Bb"[ANS) D Q 0
130 .;Echo rest of response
131 .W:(ANS="B") "ACKUP"
132 .W:(ANS="b") "ackup"
133 .H 1
134 .F ARRAYREF="INFILER","OUTFILER" D
135 ..;Move up 4 entries in list
136 ..S NEWTOP=$S(ARRAYREF="INFILER":INTOP,1:OUTTOP)
137 ..F LOOP=1:1:4 S NEWTOP=+$O(@ARRAYREF@(NEWTOP),-1) Q:('NEWTOP)
138 ..;Went past top of list - set to first entry in list
139 ..I ('NEWTOP) S NEWTOP="" S NEWTOP=+$O(@ARRAYREF@(NEWTOP))
140 ..;Save new value into appropriate variable
141 ..S:(ARRAYREF="INFILER") INTOP=NEWTOP
142 ..S:(ARRAYREF="OUTFILER") OUTTOP=NEWTOP
143 ;START/STOP/DELETE action
144 I ("+-*"[ANS) D Q 0
145 .;Remember action
146 .S ANS1=ANS
147 .;Get type of filer
148 .R ANS#1:3 Q:('$T)
149 .;Invalid response
150 .S ANS=$TR(ANS,"io","IO")
151 .Q:("IO"'[ANS)
152 .;Echo complete selection
153 .W " ",$S(ANS1="+":"START",ANS1="-":"STOP",1:"DELETE")," "
154 .W $S(ANS="O":"OUTGOING",1:"INCOMING")," FILER"
155 .H 1
156 .;START action
157 .I (ANS1="+") D Q
158 ..;Start incoming filer
159 ..I (ANS="I") S TMP=$$TASKFLR^HLCS1("IN")
160 ..;Start outgoing filer
161 ..I (ANS="O") S TMP=$$TASKFLR^HLCS1("OUT")
162 .;STOP action
163 .I (ANS1="-") D Q
164 ..S ARRAYREF=$S(ANS="I":"INFILER",1:"OUTFILER")
165 ..;Get first filer in list that hasn't been asked to stop
166 ..S TMP=0
167 ..F S TMP=+$O(@ARRAYREF@(TMP)) Q:('TMP) Q:($P(@ARRAYREF@(TMP),"^",3)="No")
168 ..;No filer to stop
169 ..Q:('TMP)
170 ..;Stop incoming filer
171 ..I (ANS="I") D STOPFLR^HLCSUTL1(TMP,"IN")
172 ..;Stop outgoing filer
173 ..I (ANS="O") D STOPFLR^HLCSUTL1(TMP,"OUT")
174 .;DELETE action
175 .S ARRAYREF=$S(ANS="I":"INFILER",1:"OUTFILER")
176 .;Find all tasks that have stopped due to error
177 .K TMPARR
178 .S LOOP=0
179 .F S LOOP=+$O(@ARRAYREF@(LOOP)) Q:('LOOP) D
180 ..;Make sure task stopped due to error
181 ..S TMP=@ARRAYREF@(LOOP)
182 ..Q:($P(TMP,"^",3)'="Error")
183 ..;Get task number
184 ..S TMP=+TMP
185 ..;Store by task number
186 ..S TMPARR(TMP)=LOOP
187 .;No selection required
188 .Q:('$O(TMPARR("")))
189 .;Make selection - autoselects on single entry
190 .S TMP=$$SELECT^HLCSFMN2("TMPARR","filer task number")
191 .;Delete selection
192 .I (TMP>0) D
193 ..;Delete incoming filer
194 ..I (ANS="I") D DELFLR^HLCSUTL1(TMPARR(TMP),"IN")
195 ..;Delete outgoing filer
196 ..I (ANS="O") D DELFLR^HLCSUTL1(TMPARR(TMP),"OUT")
197 .;Whitespace - needed for screen refreshing
198 .W !!!!!
199 ;Invalid response
200 Q 0
Note: See TracBrowser for help on using the repository browser.