HLCSFMN0 ;ALB/JRP - INCOMING/OUTGOING FILER MONITOR;19-MAY-95 ;10/15/99 06:57 [ 04/02/2003 8:38 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;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
HLCSFMN0 ;ALB/JRP - INCOMING/OUTGOING FILER MONITOR;19-MAY-95 ;10/15/99 06:57 [ 04/02/2003 8:38 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;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
