- 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 Mar 13, 2025@21:01:08 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
