HLOUSR2 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am
;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
;
EN ;
D WAIT^DICD
D EN^VALM("HLO MESSAGE VIEWER")
Q
;
SHOWLIST(TYPE) ;
;TYPE= "SE", "AE", "TF"
N PARMS,I
S (VALMBG,VALMCNT,I)=0
D CLEAN^VALM10
S VALMBG=1
I '$$ASKPARMS(.PARMS) S VALMBCK="" Q
I PARMS("ALL") D
.N APP
.S APP=""
.F S APP=$O(^HLB("ERRORS",TYPE,APP)) Q:APP="" Q:I>500 D
..N TIME,IEN
..S TIME=PARMS("START")
..Q:($O(^HLB("ERRORS",TYPE,APP,TIME))="")
..S @VALMAR@($$I,0)="Application: "_APP
..D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
..F S TIME=$O(^HLB("ERRORS",TYPE,APP,TIME)) Q:'TIME Q:VALMCNT>500 S IEN="" F S IEN=$O(^HLB("ERRORS",TYPE,APP,TIME,IEN)) Q:IEN="" Q:VALMCNT>500 D ADDTO(TYPE,IEN,TIME)
E D
.N APP
.S APP=PARMS("APP")
.N TIME,IEN
.S TIME=PARMS("START")
.Q:$O(^HLB("ERRORS",TYPE,APP,TIME))=""
.S @VALMAR@($$I,0)="Application: "_APP
.D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
.F S TIME=$O(^HLB("ERRORS",TYPE,APP,TIME)) Q:'TIME Q:VALMCNT>500 S IEN="" F S IEN=$O(^HLB("ERRORS",TYPE,APP,TIME,IEN)) Q:IEN="" Q:VALMCNT>500 D ADDTO(TYPE,IEN,TIME)
;
SHOW S VALMBCK="R"
;
Q
ADDTO(LTYPE,IEN,TIME) ;
N NODE,MSG
Q:'$$GETMSG^HLOMSG(+IEN,.MSG)
I LTYPE'="AE" D
.N TYPE
.S TYPE=$S(MSG("BATCH"):"BATCH",1:MSG("MESSAGE TYPE")_"~"_MSG("EVENT"))
.S @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),15)_$$LJ(TYPE,8)_$$LJ($$FMTE^XLFDT(TIME,2),20)_MSG("STATUS","ERROR TEXT")
.D CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
.S:MSG("ID")]"" @VALMAR@("INDEX",MSG("ID"))=IEN
E D
.;application errors - could be an error to a msg within a batch
.;also, need to go to the ack msg to get the error text from the MSA segment
.;
.N SUBIEN,MSA,ERRTEXT
.S (ERRTEXT,MSA)=""
.S SUBIEN=$P(IEN,"^",2)
.;within batch?
.D:SUBIEN GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
.I MSG("ACK BY")]"",($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1) D
..N MSG,SEG,FS
..S IEN=+LIST(1),SUBIEN=$P(LIST(1),"^",2)
..Q:'$$GETMSG^HLOMSG(IEN,.MSG)
..I SUBIEN S MSG("BATCH","CURRENT MESSAGE")=SUBIEN,MSG("LINE COUNT")=0
..F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) I $E(SEG(1),1,3)="MSA" S MSA=SEG(1),FS=$E(MSA,4),ERRTEXT=$P(MSA,FS,4) Q
.S:ERRTEXT="" ERRTEXT=MSG("STATUS","ERROR TEXT")
.S @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),15)_$$LJ(MSG("MESSAGE TYPE")_"~"_MSG("EVENT"),8)_$$LJ($$FMTE^XLFDT(MSG("DT/TM CREATED"),2),20)_$E(ERRTEXT,1,37)
.D CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
.I $L(ERRTEXT)>37 D
..S @VALMAR@($$I,0)="~"_$E(ERRTEXT,38,112)
..D CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
.S:MSG("ID")]"" @VALMAR@("INDEX",MSG("ID"))=IEN
Q
;
ASKPARMS(PARMS) ;
K PARMS
S PARMS("START")=$$ASKBEGIN("T-1")
I 'PARMS("START") Q 0
S PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
I PARMS("ALL") Q 1
I PARMS("ALL")="" Q 0
S PARMS("APP")=$$ASKAPP
I PARMS("APP")="" Q 0
Q 1
;
ASKAPP() ;
D FULL^VALM1
S VALMBCK="R"
N DIR
S DIR(0)="F^3:60"
S DIR("A")="Application"
S DIR("?")="Enter the full name of the application, or '^' to exit."
S DIR("?",1)="For transmission failures, enter the sending application. "
S DIR("?",2)="For other errors, enter the name of the receiving application. "
D ^DIR
I $D(DIRUT)!(Y="") Q ""
Q Y
;
ASKYESNO(PROMPT,DEFAULT) ;
;Description: Displays PROMPT, appending '?'. Expects a YES NO response
;Input:
; PROMPT - text to display as prompt. Appends '?'
; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
;Output:
; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
;
N DIR,Y
S DIR(0)="Y"
S DIR("A")=PROMPT
S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
D ^DIR
Q:$D(DIRUT) ""
Q Y
;
STRTSTPQ ;
;action to start or stop a queue, either incoming or outgoing
;
N STOP,INOROUT,QUE
S VALMBCK="R"
D FULL^VALM1
;ask if stop or start
D Q:STOP=""
.N DIR
.S DIR(0)="S^1:START;2:STOP"
.S DIR("A")="Do you want to START or STOP a queue"
.S DIR("B")="1"
.D ^DIR
.S STOP=$S(Y=1:0,Y=2:1,1:"")
;ask if in or out
D Q:INOROUT=""
.N DIR
.S DIR(0)="S^I:INCOMING;O:OUTGOING"
.S DIR("A")="Do you want to "_$S(STOP:"stop",1:"start")_" an incoming queue or an outgoing queue"
.S DIR("B")="I"
.D ^DIR
.S INOROUT=$S(Y="I":"IN",Y="O":"OUT",1:"")
S QUE=$$ASKQUE(INOROUT)
Q:QUE=""
I STOP=$$STOPPED^HLOQUE(INOROUT,QUE) D
.N C
.I STOP D
..W !,"That queue is already stopped!"
.E W !,"That queue is not stopped!"
.W !,IOINHI,"Hit any key to continue...",IOINORM
.R *C:DTIME
E D
.N C
.D:STOP STOPQUE^HLOQUE(INOROUT,QUE)
.D:'STOP STARTQUE^HLOQUE(INOROUT,QUE)
.W !,"DONE!"
.W !,IOINHI,"Hit any key to continue...",IOINORM
.R *C:DTIME
.D @HLRFRSH
Q
;
ASKQUE(DIR) ;
N QUEUE
AGAIN W !,"Enter the full, exact name of queue:"
S QUEUE=""
R QUEUE:60 I '$T Q ""
I $E(QUEUE)="?" W !,"Each message is placed on a queue that has an arbitrary name up to 20",!,"characters long." I $$ASKYESNO("Would you like to see a list of the queues that currently exist","NO") D G AGAIN
.N SUB,QUE,QUIT,COUNT
.K ^TMP($J,"HLO QUEUES")
.S SUB=""
.F S SUB=$O(^HLB("QUEUE",DIR,SUB)) Q:SUB="" D
..S QUE=""
..F S QUE=$O(^HLB("QUEUE",DIR,SUB,QUE)) Q:QUE="" S ^TMP($J,"HLO QUEUES",QUE)=""
.S QUE=""
.S IOSL=$G(IOSL,20)
.S (COUNT,QUIT)=0
.W !
.F S QUE=$O(^TMP($J,"HLO QUEUES",QUE)) Q:QUE="" Q:QUIT D
..W !,QUE
..S COUNT=COUNT+1
..I COUNT>(IOSL-3) D
...N Y
...D PAUSE^VALM1
...I 'Y S QUIT=1
...S COUNT=0
.W !
.K ^TMP($J,"HLO QUEUES")
Q:$E(QUEUE)="?" ""
Q:$E(QUEUE)="^" ""
Q QUEUE
;
ASKBEGIN(DEFAULT) ;
;Description: Asks the user to enter a beginning date.
;Input: DEFAULT - the suggested default dt/time (optional)
;Output: Returns the date as the function value, or 0 if the user does not select a date
;
;
N %DT
S %DT="AEST"
S %DT("A")="Enter the beginning date/time: "
S %DT("B")=$$FMTE^XLFDT($S($L($G(DEFAULT)):DEFAULT,1:$$FMADD^XLFDT(DT,-1)))
S %DT(0)="-NOW"
Q:$D(DTOUT) 0
D ^%DT
I Y=-1 Q 0
Q Y
;
ASKEND(BEGIN) ;
;Description: Asks the user to enter an ending date/time
;Input: BEGIN - the earliest date/time allowed
;Output: Returns the date as the function value, or 0 if the user does not select a date/time
;
N %DT
S %DT="AEST"
S %DT("A")="Enter the ending date/time: "
S %DT("B")="NOW"
S %DT(0)=BEGIN
Q:$D(DTOUT) 0
D ^%DT
I Y=-1 Q 0
Q Y
;
LJ(STRING,LEN) ;
Q $$LJ^XLFSTR(STRING,LEN)
;
I() ;
S VALMCNT=VALMCNT+1
Q VALMCNT
;
Q
HLOUSR2 ;ALB/CJM -ListManager Screen for viewing messages(continued);12 JUN 1997 10:00 am
+1 ;;1.6;HEALTH LEVEL SEVEN;**126**;Oct 13, 1995
+2 ;
EN ;
+1 DO WAIT^DICD
+2 DO EN^VALM("HLO MESSAGE VIEWER")
+3 QUIT
+4 ;
SHOWLIST(TYPE) ;
+1 ;TYPE= "SE", "AE", "TF"
+2 NEW PARMS,I
+3 SET (VALMBG,VALMCNT,I)=0
+4 DO CLEAN^VALM10
+5 SET VALMBG=1
+6 IF '$$ASKPARMS(.PARMS)
SET VALMBCK=""
QUIT
+7 IF PARMS("ALL")
Begin DoDot:1
+8 NEW APP
+9 SET APP=""
+10 FOR
SET APP=$ORDER(^HLB("ERRORS",TYPE,APP))
IF APP=""
QUIT
IF I>500
QUIT
Begin DoDot:2
+11 NEW TIME,IEN
+12 SET TIME=PARMS("START")
+13 IF ($ORDER(^HLB("ERRORS",TYPE,APP,TIME))="")
QUIT
+14 SET @VALMAR@($$I,0)="Application: "_APP
+15 DO CNTRL^VALM10(VALMCNT,14,$LENGTH(APP),IOINHI,IOINORM)
+16 FOR
SET TIME=$ORDER(^HLB("ERRORS",TYPE,APP,TIME))
IF 'TIME
QUIT
IF VALMCNT>500
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(^HLB("ERRORS",TYPE,APP,TIME,IEN))
IF IEN=""
QUIT
IF VALMCNT>500
QUIT
DO ADDTO(TYPE,IEN,TIME)
End DoDot:2
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 NEW APP
+19 SET APP=PARMS("APP")
+20 NEW TIME,IEN
+21 SET TIME=PARMS("START")
+22 IF $ORDER(^HLB("ERRORS",TYPE,APP,TIME))=""
QUIT
+23 SET @VALMAR@($$I,0)="Application: "_APP
+24 DO CNTRL^VALM10(VALMCNT,14,$LENGTH(APP),IOINHI,IOINORM)
+25 FOR
SET TIME=$ORDER(^HLB("ERRORS",TYPE,APP,TIME))
IF 'TIME
QUIT
IF VALMCNT>500
QUIT
SET IEN=""
FOR
SET IEN=$ORDER(^HLB("ERRORS",TYPE,APP,TIME,IEN))
IF IEN=""
QUIT
IF VALMCNT>500
QUIT
DO ADDTO(TYPE,IEN,TIME)
End DoDot:1
+26 ;
SHOW SET VALMBCK="R"
+1 ;
+2 QUIT
ADDTO(LTYPE,IEN,TIME) ;
+1 NEW NODE,MSG
+2 IF '$$GETMSG^HLOMSG(+IEN,.MSG)
QUIT
+3 IF LTYPE'="AE"
Begin DoDot:1
+4 NEW TYPE
+5 SET TYPE=$SELECT(MSG("BATCH"):"BATCH",1:MSG("MESSAGE TYPE")_"~"_MSG("EVENT"))
+6 SET @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),15)_$$LJ(TYPE,8)_$$LJ($$FMTE^XLFDT(TIME,2),20)_MSG("STATUS","ERROR TEXT")
+7 DO CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
+8 IF MSG("ID")]""
SET @VALMAR@("INDEX",MSG("ID"))=IEN
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 ;application errors - could be an error to a msg within a batch
+11 ;also, need to go to the ack msg to get the error text from the MSA segment
+12 ;
+13 NEW SUBIEN,MSA,ERRTEXT
+14 SET (ERRTEXT,MSA)=""
+15 SET SUBIEN=$PIECE(IEN,"^",2)
+16 ;within batch?
+17 IF SUBIEN
DO GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
+18 IF MSG("ACK BY")]""
IF ($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1)
Begin DoDot:2
+19 NEW MSG,SEG,FS
+20 SET IEN=+LIST(1)
SET SUBIEN=$PIECE(LIST(1),"^",2)
+21 IF '$$GETMSG^HLOMSG(IEN,.MSG)
QUIT
+22 IF SUBIEN
SET MSG("BATCH","CURRENT MESSAGE")=SUBIEN
SET MSG("LINE COUNT")=0
+23 FOR
IF '$$HLNEXT^HLOMSG(.MSG,.SEG)
QUIT
IF $EXTRACT(SEG(1),1,3)="MSA"
SET MSA=SEG(1)
SET FS=$EXTRACT(MSA,4)
SET ERRTEXT=$PIECE(MSA,FS,4)
QUIT
End DoDot:2
+24 IF ERRTEXT=""
SET ERRTEXT=MSG("STATUS","ERROR TEXT")
+25 SET @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),15)_$$LJ(MSG("MESSAGE TYPE")_"~"_MSG("EVENT"),8)_$$LJ($$FMTE^XLFDT(MSG("DT/TM CREATED"),2),20)_$EXTRACT(ERRTEXT,1,37)
+26 DO CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
+27 IF $LENGTH(ERRTEXT)>37
Begin DoDot:2
+28 SET @VALMAR@($$I,0)="~"_$EXTRACT(ERRTEXT,38,112)
+29 DO CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
End DoDot:2
+30 IF MSG("ID")]""
SET @VALMAR@("INDEX",MSG("ID"))=IEN
End DoDot:1
+31 QUIT
+32 ;
ASKPARMS(PARMS) ;
+1 KILL PARMS
+2 SET PARMS("START")=$$ASKBEGIN("T-1")
+3 IF 'PARMS("START")
QUIT 0
+4 SET PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
+5 IF PARMS("ALL")
QUIT 1
+6 IF PARMS("ALL")=""
QUIT 0
+7 SET PARMS("APP")=$$ASKAPP
+8 IF PARMS("APP")=""
QUIT 0
+9 QUIT 1
+10 ;
ASKAPP() ;
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 NEW DIR
+4 SET DIR(0)="F^3:60"
+5 SET DIR("A")="Application"
+6 SET DIR("?")="Enter the full name of the application, or '^' to exit."
+7 SET DIR("?",1)="For transmission failures, enter the sending application. "
+8 SET DIR("?",2)="For other errors, enter the name of the receiving application. "
+9 DO ^DIR
+10 IF $DATA(DIRUT)!(Y="")
QUIT ""
+11 QUIT Y
+12 ;
ASKYESNO(PROMPT,DEFAULT) ;
+1 ;Description: Displays PROMPT, appending '?'. Expects a YES NO response
+2 ;Input:
+3 ; PROMPT - text to display as prompt. Appends '?'
+4 ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
+5 ;Output:
+6 ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
+7 ;
+8 NEW DIR,Y
+9 SET DIR(0)="Y"
+10 SET DIR("A")=PROMPT
+11 SET DIR("B")=$SELECT($GET(DEFAULT)="NO":"NO",1:"YES")
+12 DO ^DIR
+13 IF $DATA(DIRUT)
QUIT ""
+14 QUIT Y
+15 ;
STRTSTPQ ;
+1 ;action to start or stop a queue, either incoming or outgoing
+2 ;
+3 NEW STOP,INOROUT,QUE
+4 SET VALMBCK="R"
+5 DO FULL^VALM1
+6 ;ask if stop or start
+7 Begin DoDot:1
+8 NEW DIR
+9 SET DIR(0)="S^1:START;2:STOP"
+10 SET DIR("A")="Do you want to START or STOP a queue"
+11 SET DIR("B")="1"
+12 DO ^DIR
+13 SET STOP=$SELECT(Y=1:0,Y=2:1,1:"")
End DoDot:1
IF STOP=""
QUIT
+14 ;ask if in or out
+15 Begin DoDot:1
+16 NEW DIR
+17 SET DIR(0)="S^I:INCOMING;O:OUTGOING"
+18 SET DIR("A")="Do you want to "_$SELECT(STOP:"stop",1:"start")_" an incoming queue or an outgoing queue"
+19 SET DIR("B")="I"
+20 DO ^DIR
+21 SET INOROUT=$SELECT(Y="I":"IN",Y="O":"OUT",1:"")
End DoDot:1
IF INOROUT=""
QUIT
+22 SET QUE=$$ASKQUE(INOROUT)
+23 IF QUE=""
QUIT
+24 IF STOP=$$STOPPED^HLOQUE(INOROUT,QUE)
Begin DoDot:1
+25 NEW C
+26 IF STOP
Begin DoDot:2
+27 WRITE !,"That queue is already stopped!"
End DoDot:2
+28 IF '$TEST
WRITE !,"That queue is not stopped!"
+29 WRITE !,IOINHI,"Hit any key to continue...",IOINORM
+30 READ *C:DTIME
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 NEW C
+33 IF STOP
DO STOPQUE^HLOQUE(INOROUT,QUE)
+34 IF 'STOP
DO STARTQUE^HLOQUE(INOROUT,QUE)
+35 WRITE !,"DONE!"
+36 WRITE !,IOINHI,"Hit any key to continue...",IOINORM
+37 READ *C:DTIME
+38 DO @HLRFRSH
End DoDot:1
+39 QUIT
+40 ;
ASKQUE(DIR) ;
+1 NEW QUEUE
AGAIN WRITE !,"Enter the full, exact name of queue:"
+1 SET QUEUE=""
+2 READ QUEUE:60
IF '$TEST
QUIT ""
+3 IF $EXTRACT(QUEUE)="?"
WRITE !,"Each message is placed on a queue that has an arbitrary name up to 20",!,"characters long."
IF $$ASKYESNO("Would you like to see a list of the queues that currently exist","NO")
Begin DoDot:1
+4 NEW SUB,QUE,QUIT,COUNT
+5 KILL ^TMP($JOB,"HLO QUEUES")
+6 SET SUB=""
+7 FOR
SET SUB=$ORDER(^HLB("QUEUE",DIR,SUB))
IF SUB=""
QUIT
Begin DoDot:2
+8 SET QUE=""
+9 FOR
SET QUE=$ORDER(^HLB("QUEUE",DIR,SUB,QUE))
IF QUE=""
QUIT
SET ^TMP($JOB,"HLO QUEUES",QUE)=""
End DoDot:2
+10 SET QUE=""
+11 SET IOSL=$GET(IOSL,20)
+12 SET (COUNT,QUIT)=0
+13 WRITE !
+14 FOR
SET QUE=$ORDER(^TMP($JOB,"HLO QUEUES",QUE))
IF QUE=""
QUIT
IF QUIT
QUIT
Begin DoDot:2
+15 WRITE !,QUE
+16 SET COUNT=COUNT+1
+17 IF COUNT>(IOSL-3)
Begin DoDot:3
+18 NEW Y
+19 DO PAUSE^VALM1
+20 IF 'Y
SET QUIT=1
+21 SET COUNT=0
End DoDot:3
End DoDot:2
+22 WRITE !
+23 KILL ^TMP($JOB,"HLO QUEUES")
End DoDot:1
GOTO AGAIN
+24 IF $EXTRACT(QUEUE)="?"
QUIT ""
+25 IF $EXTRACT(QUEUE)="^"
QUIT ""
+26 QUIT QUEUE
+27 ;
ASKBEGIN(DEFAULT) ;
+1 ;Description: Asks the user to enter a beginning date.
+2 ;Input: DEFAULT - the suggested default dt/time (optional)
+3 ;Output: Returns the date as the function value, or 0 if the user does not select a date
+4 ;
+5 ;
+6 NEW %DT
+7 SET %DT="AEST"
+8 SET %DT("A")="Enter the beginning date/time: "
+9 SET %DT("B")=$$FMTE^XLFDT($SELECT($LENGTH($GET(DEFAULT)):DEFAULT,1:$$FMADD^XLFDT(DT,-1)))
+10 SET %DT(0)="-NOW"
+11 IF $DATA(DTOUT)
QUIT 0
+12 DO ^%DT
+13 IF Y=-1
QUIT 0
+14 QUIT Y
+15 ;
ASKEND(BEGIN) ;
+1 ;Description: Asks the user to enter an ending date/time
+2 ;Input: BEGIN - the earliest date/time allowed
+3 ;Output: Returns the date as the function value, or 0 if the user does not select a date/time
+4 ;
+5 NEW %DT
+6 SET %DT="AEST"
+7 SET %DT("A")="Enter the ending date/time: "
+8 SET %DT("B")="NOW"
+9 SET %DT(0)=BEGIN
+10 IF $DATA(DTOUT)
QUIT 0
+11 DO ^%DT
+12 IF Y=-1
QUIT 0
+13 QUIT Y
+14 ;
LJ(STRING,LEN) ;
+1 QUIT $$LJ^XLFSTR(STRING,LEN)
+2 ;
I() ;
+1 SET VALMCNT=VALMCNT+1
+2 QUIT VALMCNT
+3 ;
+1 QUIT
