source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSFMN.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1HLCSFMN ;ALB/JRP - INCOMING/OUTGOING FILER MONITOR;19-MAY-95 ;06/25/97 15:03
2 ;;1.6;HEALTH LEVEL SEVEN;**15,30**;Oct 13, 1995
3MONITOR ;Main entry point
4 ;Declare variables
5 N INFILER,OUTFILER,INCOUNT,OUTCOUNT,INTOP,OUTTOP,STOP
6 N X S X=0 X ^%ZOSF("RM")
7 ; Turn off terminal line wrap
8 S (INTOP,OUTTOP)=0
9 ;Get screen attributes used
10 D GETATTR^HLCSFMN1
11 ;Initial clear screen
12 W @IOF
13 ;Continually display updated information until user chooses to quit
14 F S STOP=0 D Q:(STOP)
15 .;Get incoming filer information
16 .S INCOUNT=$$GETINFO^HLCSFMN1("IN","INFILER")
17 .;Set pointer to top of filer lists - if needed
18 .S:('INTOP) INTOP=+$O(INFILER(""))
19 .;Get outgoing filer information
20 .S OUTCOUNT=$$GETINFO^HLCSFMN1("OUT","OUTFILER")
21 .;Set pointer to top of filer lists - if needed
22 .S:('OUTTOP) OUTTOP=+$O(OUTFILER(""))
23 .;Display incoming filer information
24 .D DISPLAY("IN","INFILER",INCOUNT,INTOP)
25 .;Display outgoing filer information
26 .D DISPLAY("OUT","OUTFILER",OUTCOUNT,OUTTOP)
27 .;Prompt/execute action
28 .S STOP=$$PROMPT^HLCSFMN0()
29 ;Delete screen attributes
30 S X=IOM X ^%ZOSF("RM")
31 ; Turn terminal line wrap back on
32 D KILL^%ZISS
33 Q
34DISPLAY(FLRTYPE,ARRAY,COUNT,PTRTOP) ;Display filer information
35 ;INPUT : FLRTYPE - Flag indicating type of filer header is for
36 ; IN = Incoming filer (default)
37 ; OUT = Outgoing filer
38 ; ARRAY - Array containing filer information (full global ref)
39 ; ARRAY(PtrSubEntry) = TaskNumber ^ Last$H ^ StopFlag ^
40 ; Printable$H ^ ErrorMessage
41 ; PtrSubEntry = Pointer to subentry in file 869.3
42 ; TaskNumber = Task number of filer
43 ; Last$H = Last known $H (field #.03 of subentry)
44 ; StopFlag = Whether or not filer has been asked to stop
45 ; (field #.02 of subentry)
46 ; Yes - Filer has been asked to stop
47 ; No - Filer has not been asked to stop
48 ; Error - Task stopped due to error
49 ; Printable$H = Last$H in printable format
50 ; ErrorMessage = Printable error message - only used when
51 ; task stopped due to error
52 ; COUNT - Number of filers running
53 ; Defaults to 0
54 ; PTRTOP - Pointer to first filer in list to display
55 ; Defaults to 0
56 ; The following screen attributes
57 ; IOINORM, IOINHI, IOUON, IOUOFF, IOBON, IOBOFF
58 ; IORVON, IORVOFF, IOF, IOHOME, IOELEOL
59 ;OUTPUT : None
60 ;
61 ;Check input
62 S FLRTYPE=$G(FLRTYPE)
63 S:(FLRTYPE'="OUT") FLRTYPE="IN"
64 Q:($G(ARRAY)="")
65 S COUNT=+$G(COUNT)
66 S PTRTOP=+$G(PTRTOP)
67 ;Declare variables
68 N PTRSUB,LOOP,FLRINFO,LASTDH,ASK2STOP,TASKNUM,ERRMSG
69 N DAY,TIME,HOUR,MIN,SEC,PASTTOL,BLANKS,FLRDH,TMP
70 S BLANKS=$J(" ",20)
71 ;Incoming filer is at top of screen
72 I (FLRTYPE="IN") D
73 .;Check for IOHOME & IOELEOL - used to keep from clearing screen
74 .W:((IOHOME'="")&(IOELEOL'="")) IOHOME
75 .;IOHOME & IOELEOL can't be used - clear screen
76 .W:((IOHOME="")!(IOELEOL="")) @IOF
77 .W IOELEOL,!
78 ;Display filer information
79 D HEADER^HLCSFMN0(FLRTYPE)
80 I ('COUNT) D Q
81 .;No filers running
82 .W IOBON,IOINHI,"** No "
83 .W $S(FLRTYPE="OUT":"outgoing",1:"incoming")
84 .W " filers are running **",IOBOFF,IOINORM
85 .W IOELEOL,!,IOELEOL,!,IOELEOL,!,IOELEOL,!
86 .;Whitespace between display areas - use less if dashes where used
87 .; in header
88 .W:((IOUON'="")&(IOUOFF'="")) IOELEOL,!,IOELEOL,!
89 .W:((IOUON="")!(IOUOFF="")) IOELEOL,!
90 ;Loop through filers (print no more than 4)
91 ; Back up one entry in list so that pointer to top entry is
92 ; first entry displayed
93 S PTRSUB=+$O(@ARRAY@(PTRTOP),-1)
94 F LOOP=1:1:4 S PTRSUB=+$O(@ARRAY@(PTRSUB)) Q:('PTRSUB) D
95 .;Get info from array
96 .S FLRINFO=@ARRAY@(PTRSUB)
97 .;Get task number
98 .S TASKNUM=$P(FLRINFO,"^",1)
99 .;Get last known $H
100 .S FLRDH=$P(FLRINFO,"^",2)
101 .;Get asked to stop flag
102 .S ASK2STOP=$P(FLRINFO,"^",3)
103 .;Get printable last known $H
104 .S LASTDH=$P(FLRINFO,"^",4)
105 .;Get error message
106 .S ERRMSG=$P(FLRINFO,"^",5)
107 .;Calculate time difference
108 .S TMP=$$DIFFDH^HLCSFMN1(FLRDH,$H)
109 .S DAY=+TMP
110 .S TIME=$P(TMP,"^",2)
111 .S HOUR=$P(TIME,":",1)
112 .S MIN=$P(TIME,":",2)
113 .S SEC=$P(TIME,":",3)
114 .;Last known $H not set yet
115 .I (FLRDH="") D
116 ..S LASTDH="--------- @ --:--:--"
117 ..S DAY="-"
118 ..S (HOUR,MIN,SEC)="--"
119 .;Print information
120 .; Print task number
121 .W TASKNUM,$E(BLANKS,1,(15-$L(TASKNUM)+3))
122 .;Print stop flag
123 .W ASK2STOP,$E(BLANKS,1,(7-$L(ASK2STOP)+3))
124 .;Problem with task - error message defined
125 .I (ERRMSG'="") D Q
126 ..;Not an error with task - don't use special attributes
127 ..I (ASK2STOP'="Error") W ERRMSG,IOELEOL,! Q
128 ..W IOELEOL S DX=0,DY=$Y X ^%ZOSF("XY") W IOINHI,IOBON,ERRMSG,IOBOFF,IOINORM,!
129 .;Task still running - determine if time difference is within
130 .; tolerance level
131 .S PASTTOL=0
132 .S:((DAY)!(HOUR)!(MIN>9)) PASTTOL=1
133 .;Bold on (if outside tolerance level)
134 .W:(PASTTOL) IOINHI
135 .;Print last known $H
136 .W LASTDH,$E(BLANKS,1,3)
137 .;Print time lapse
138 .W IOELEOL S DX=0,DY=$Y X ^%ZOSF("XY") W DAY," Day ",HOUR," Hr ",MIN," Min ",SEC," Sec",!
139 .;Bold off (if outside tolerance level)
140 .W:(PASTTOL) IOINORM
141 ;End of list reached
142 I ((LOOP'=4)!('PTRSUB)) D
143 .W IORVON,"[End of list - total of ",COUNT,"]",IORVOFF,IOELEOL,!
144 .F TMP=1:1:(4-LOOP) W IOELEOL,!
145 ;Whitespace between display areas - use less if dashes where used
146 ; in header
147 W:((IOUON'="")&(IOUOFF'="")) IOELEOL,!,IOELEOL,!
148 W:((IOUON="")!(IOUOFF="")) IOELEOL,!
149 Q
Note: See TracBrowser for help on using the repository browser.