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