Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOUSR2

HLOUSR2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN ;
  1.  D WAIT^DICD
  1.  D EN^VALM("HLO MESSAGE VIEWER")
  1.  Q
  1.  ;
  1. SHOWLIST(TYPE) ;
  1.  ;TYPE= "SE", "AE", "TF"
  1.  N PARMS,I
  1.  S (VALMBG,VALMCNT,I)=0
  1.  D CLEAN^VALM10
  1.  S VALMBG=1
  1.  I '$$ASKPARMS(.PARMS) S VALMBCK="" Q
  1.  I PARMS("ALL") D
  1.  .N APP
  1.  .S APP=""
  1.  .F  S APP=$O(^HLB("ERRORS",TYPE,APP)) Q:APP=""  Q:I>500  D
  1.  ..N TIME,IEN
  1.  ..S TIME=PARMS("START")
  1.  ..Q:($O(^HLB("ERRORS",TYPE,APP,TIME))="")
  1.  ..S @VALMAR@($$I,0)="Application: "_APP
  1.  ..D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
  1.  ..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)
  1.  E  D
  1.  .N APP
  1.  .S APP=PARMS("APP")
  1.  .N TIME,IEN
  1.  .S TIME=PARMS("START")
  1.  .Q:$O(^HLB("ERRORS",TYPE,APP,TIME))=""
  1.  .S @VALMAR@($$I,0)="Application: "_APP
  1.  .D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
  1.  .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)
  1.  ;
  1. SHOW S VALMBCK="R"
  1.  ;
  1.  Q
  1. ADDTO(LTYPE,IEN,TIME) ;
  1.  N NODE,MSG
  1.  Q:'$$GETMSG^HLOMSG(+IEN,.MSG)
  1.  I LTYPE'="AE" D
  1.  .N TYPE
  1.  .S TYPE=$S(MSG("BATCH"):"BATCH",1:MSG("MESSAGE TYPE")_"~"_MSG("EVENT"))
  1.  .S @VALMAR@($$I,0)="  "_$$LJ(MSG("ID"),15)_$$LJ(TYPE,8)_$$LJ($$FMTE^XLFDT(TIME,2),20)_MSG("STATUS","ERROR TEXT")
  1.  .D CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
  1.  .S:MSG("ID")]"" @VALMAR@("INDEX",MSG("ID"))=IEN
  1.  E  D
  1.  .;application errors - could be an error to a msg within a batch
  1.  .;also, need to go to the ack msg to get the error text from the MSA segment
  1.  .;
  1.  .N SUBIEN,MSA,ERRTEXT
  1.  .S (ERRTEXT,MSA)=""
  1.  .S SUBIEN=$P(IEN,"^",2)
  1.  .;within batch?
  1.  .D:SUBIEN GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
  1.  .I MSG("ACK BY")]"",($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1) D
  1.  ..N MSG,SEG,FS
  1.  ..S IEN=+LIST(1),SUBIEN=$P(LIST(1),"^",2)
  1.  ..Q:'$$GETMSG^HLOMSG(IEN,.MSG)
  1.  ..I SUBIEN S MSG("BATCH","CURRENT MESSAGE")=SUBIEN,MSG("LINE COUNT")=0
  1.  ..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
  1.  .S:ERRTEXT="" ERRTEXT=MSG("STATUS","ERROR TEXT")
  1.  .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)
  1.  .D CNTRL^VALM10(VALMCNT,3,15,IOINHI,IOINORM)
  1.  .I $L(ERRTEXT)>37 D
  1.  ..S @VALMAR@($$I,0)="~"_$E(ERRTEXT,38,112)
  1.  ..D CNTRL^VALM10(VALMCNT,1,1,IORVON,IORVOFF)
  1.  .S:MSG("ID")]"" @VALMAR@("INDEX",MSG("ID"))=IEN
  1.  Q
  1.  ;
  1. ASKPARMS(PARMS) ;
  1.  K PARMS
  1.  S PARMS("START")=$$ASKBEGIN("T-1")
  1.  I 'PARMS("START") Q 0
  1.  S PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
  1.  I PARMS("ALL") Q 1
  1.  I PARMS("ALL")="" Q 0
  1.  S PARMS("APP")=$$ASKAPP
  1.  I PARMS("APP")="" Q 0
  1.  Q 1
  1.  ;
  1. ASKAPP() ;
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  N DIR
  1.  S DIR(0)="F^3:60"
  1.  S DIR("A")="Application"
  1.  S DIR("?")="Enter the full name of the application, or '^' to exit."
  1.  S DIR("?",1)="For transmission failures, enter the sending application. "
  1.  S DIR("?",2)="For other errors, enter the name of the receiving application. "
  1.  D ^DIR
  1.  I $D(DIRUT)!(Y="") Q ""
  1.  Q Y
  1.  ;
  1. ASKYESNO(PROMPT,DEFAULT) ;
  1.  ;Description: Displays PROMPT, appending '?'.  Expects a YES NO response
  1.  ;Input:
  1.  ;   PROMPT - text to display as prompt.  Appends '?'
  1.  ;   DEFAULT - (optional) YES or NO.  If not passed, defaults to YES
  1.  ;Output:
  1.  ;  Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
  1.  ;
  1.  N DIR,Y
  1.  S DIR(0)="Y"
  1.  S DIR("A")=PROMPT
  1.  S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
  1.  D ^DIR
  1.  Q:$D(DIRUT) ""
  1.  Q Y
  1.  ;
  1. STRTSTPQ ;
  1.  ;action to start or stop a queue, either incoming or outgoing
  1.  ;
  1.  N STOP,INOROUT,QUE
  1.  S VALMBCK="R"
  1.  D FULL^VALM1
  1.  ;ask if stop or start
  1.  D  Q:STOP=""
  1.  .N DIR
  1.  .S DIR(0)="S^1:START;2:STOP"
  1.  .S DIR("A")="Do you want to START or STOP a queue"
  1.  .S DIR("B")="1"
  1.  .D ^DIR
  1.  .S STOP=$S(Y=1:0,Y=2:1,1:"")
  1.  ;ask if in or out
  1.  D  Q:INOROUT=""
  1.  .N DIR
  1.  .S DIR(0)="S^I:INCOMING;O:OUTGOING"
  1.  .S DIR("A")="Do you want to "_$S(STOP:"stop",1:"start")_" an incoming queue or an outgoing queue"
  1.  .S DIR("B")="I"
  1.  .D ^DIR
  1.  .S INOROUT=$S(Y="I":"IN",Y="O":"OUT",1:"")
  1.  S QUE=$$ASKQUE(INOROUT)
  1.  Q:QUE=""
  1.  I STOP=$$STOPPED^HLOQUE(INOROUT,QUE) D
  1.  .N C
  1.  .I STOP D
  1.  ..W !,"That queue is already stopped!"
  1.  .E  W !,"That queue is not stopped!"
  1.  .W !,IOINHI,"Hit any key to continue...",IOINORM
  1.  .R *C:DTIME
  1.  E  D
  1.  .N C
  1.  .D:STOP STOPQUE^HLOQUE(INOROUT,QUE)
  1.  .D:'STOP STARTQUE^HLOQUE(INOROUT,QUE)
  1.  .W !,"DONE!"
  1.  .W !,IOINHI,"Hit any key to continue...",IOINORM
  1.  .R *C:DTIME
  1.  .D @HLRFRSH
  1.  Q
  1.  ;
  1. ASKQUE(DIR) ;
  1.  N QUEUE
  1. AGAIN W !,"Enter the full, exact name of queue:"
  1.  S QUEUE=""
  1.  R QUEUE:60 I '$T Q ""
  1.  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
  1.  .N SUB,QUE,QUIT,COUNT
  1.  .K ^TMP($J,"HLO QUEUES")
  1.  .S SUB=""
  1.  .F  S SUB=$O(^HLB("QUEUE",DIR,SUB)) Q:SUB=""  D
  1.  ..S QUE=""
  1.  ..F  S QUE=$O(^HLB("QUEUE",DIR,SUB,QUE)) Q:QUE=""  S ^TMP($J,"HLO QUEUES",QUE)=""
  1.  .S QUE=""
  1.  .S IOSL=$G(IOSL,20)
  1.  .S (COUNT,QUIT)=0
  1.  .W !
  1.  .F  S QUE=$O(^TMP($J,"HLO QUEUES",QUE)) Q:QUE=""  Q:QUIT  D
  1.  ..W !,QUE
  1.  ..S COUNT=COUNT+1
  1.  ..I COUNT>(IOSL-3) D
  1.  ...N Y
  1.  ...D PAUSE^VALM1
  1.  ...I 'Y S QUIT=1
  1.  ...S COUNT=0
  1.  .W !
  1.  .K ^TMP($J,"HLO QUEUES")
  1.  Q:$E(QUEUE)="?" ""
  1.  Q:$E(QUEUE)="^" ""
  1.  Q QUEUE
  1.  ;
  1. ASKBEGIN(DEFAULT) ;
  1.  ;Description: Asks the user to enter a beginning date.
  1.  ;Input: DEFAULT - the suggested default dt/time (optional)
  1.  ;Output: Returns the date as the function value, or 0 if the user does not select a date
  1.  ;
  1.  ;
  1.  N %DT
  1.  S %DT="AEST"
  1.  S %DT("A")="Enter the beginning date/time: "
  1.  S %DT("B")=$$FMTE^XLFDT($S($L($G(DEFAULT)):DEFAULT,1:$$FMADD^XLFDT(DT,-1)))
  1.  S %DT(0)="-NOW"
  1.  Q:$D(DTOUT) 0
  1.  D ^%DT
  1.  I Y=-1 Q 0
  1.  Q Y
  1.  ;
  1. ASKEND(BEGIN) ;
  1.  ;Description: Asks the user to enter an ending date/time
  1.  ;Input: BEGIN - the earliest date/time allowed
  1.  ;Output: Returns the date as the function value, or 0 if the user does not select a date/time
  1.  ;
  1.  N %DT
  1.  S %DT="AEST"
  1.  S %DT("A")="Enter the ending date/time: "
  1.  S %DT("B")="NOW"
  1.  S %DT(0)=BEGIN
  1.  Q:$D(DTOUT) 0
  1.  D ^%DT
  1.  I Y=-1 Q 0
  1.  Q Y
  1.  ;
  1. LJ(STRING,LEN) ;
  1.  Q $$LJ^XLFSTR(STRING,LEN)
  1.  ;
  1. I() ;
  1.  S VALMCNT=VALMCNT+1
  1.  Q VALMCNT
  1.  ;
  1.  Q