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