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 message errors;12 JUN 1997 10:00 am ;07/27/2010
  1. ;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138,147**;Oct 13, 1995;Build 15
  1. ;Per VHA Directive 2004-038, this routine should not be modified
  1. ;
  1. EN ;
  1. D WAIT^DICD
  1. D EN^VALM("HLO MESSAGE VIEWER")
  1. Q
  1. ;
  1. SHOWLIST ;
  1. N PARMS,I,ERRCOUNT,SCREEN
  1. S (VALMBG,VALMCNT,I,ERRCOUNT,SCREEN)=0
  1. D CLEAN^VALM10
  1. S VALMBG=1
  1. I '$$ASKPARMS(.PARMS) S VALMBCK="" Q
  1. ;
  1. I PARMS("SCR") S SCREEN=$$GETSCRN(+PARMS("SCR"),.SCREEN)
  1. I PARMS("ALL") D
  1. .N APP
  1. .S APP=""
  1. .F S APP=$O(^HLB("ERRORS",APP)) Q:APP="" D Q:ERRCOUNT>PARMS("MAX")
  1. ..N TIME,IEN
  1. ..S TIME=PARMS("START")
  1. ..Q:($O(^HLB("ERRORS",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",APP,TIME)) Q:'TIME Q:ERRCOUNT>PARMS("MAX") S IEN="" F S IEN=$O(^HLB("ERRORS",APP,TIME,IEN)) Q:IEN="" D ADDTO(IEN,TIME,.SCREEN,.ERRCOUNT) Q:ERRCOUNT>PARMS("MAX")
  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",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",APP,TIME)) Q:'TIME Q:ERRCOUNT>PARMS("MAX") S IEN="" F S IEN=$O(^HLB("ERRORS",APP,TIME,IEN)) Q:IEN="" D ADDTO(IEN,TIME,.SCREEN,.ERRCOUNT) Q:ERRCOUNT>PARMS("MAX")
  1. SHOW S VALMBCK="R"
  1. ;
  1. Q
  1. ADDTO(IEN,TIME,SCREEN,ERRCOUNT) ;
  1. N NODE,MSG,LIST,SKIP
  1. Q:'$$STARTMSG^HLOPRS(.MSG,+IEN)
  1. ;S ERRCOUNT=ERRCOUNT+1
  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. S ERRTEXT=MSG("STATUS","ERROR TEXT")
  1. I ERRTEXT="",MSG("ACK BY")]"",($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1) D
  1. .N MSG,SEG,FS,AIEN
  1. .S AIEN=+LIST(1),SUBIEN=$P(LIST(1),"^",2)
  1. .Q:'$$STARTMSG^HLOPRS(.MSG,AIEN)
  1. .I SUBIEN S MSG("BATCH","CURRENT MESSAGE")=SUBIEN,MSG("LINE COUNT")=0
  1. .; ** Start HL*1.6*138 PIJ **
  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. .F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) I $E(SEG(1),1,3)="MSA" S MSA=SEG(1),FS=$E(MSA,4) D Q
  1. ..S ERRTEXT=$$ESCAPE^HLOPBLD(.MSG,$P(MSA,FS,4))
  1. .; ** End HL*1.6*138 **
  1. I ERRTEXT="",MSG("ACK BY")="" D
  1. .N FS
  1. .S FS=$E(MSG("HDR",1),4)
  1. .I $L(FS) S ERRTEXT=$P($G(MSG("STATUS","ACCEPT ACK MSA")),FS,4)
  1. I SCREEN,'$$SCREEN(ERRTEXT,.SCREEN) Q
  1. S ERRCOUNT=ERRCOUNT+1
  1. S @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),25)_$S(MSG("BATCH"):"BATCH ",1:$$LJ($G(MSG("MESSAGE TYPE"))_"~"_$G(MSG("EVENT")),8))_$$LJ($$FMTE^XLFDT(MSG("DT/TM CREATED"),2),20)_$E(ERRTEXT,1,35)
  1. D CNTRL^VALM10(VALMCNT,3,25,IOINHI,IOINORM)
  1. I $L(ERRTEXT)>35 D
  1. .S @VALMAR@($$I,0)=$$RJ(" ",45)_$E(ERRTEXT,36,115)
  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("MAX")=$$ASKMAX()
  1. Q:'(PARMS("MAX")>-1) 0
  1. S PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
  1. ;
  1. ; *** BEGIN HL*1.6*147 - RBN
  1. ;
  1. ;I PARMS("ALL") Q 1
  1. I PARMS("ALL")="" Q 0
  1. ;S PARMS("APP")=$$ASKAPP()
  1. I 'PARMS("ALL") D Q:PARMS("APP")="" 0
  1. . S PARMS("APP")=$$ASKAPP()
  1. S PARMS("SCR")=$$ASKSCR()
  1. ;
  1. ; ** END HL*1.6*147 - RBN
  1. ;
  1. Q 1
  1. ;
  1. ASKMAX() ;
  1. N DIR
  1. S DIR(0)="N^1:30000:0"
  1. S DIR("A")="Maximum List Size"
  1. S DIR("B")=1000
  1. S DIR("?",1)="In case a large number of errors meet your search criteria, what are the"
  1. S DIR("?")="maximum number of errors to display? (30,000 maximum)"
  1. D ^DIR
  1. Q:$D(DTOUT)!$D(DUOUT) -1
  1. Q X-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")="Receiving Application"
  1. S DIR("?")="Enter the full name of the application, or '^' to exit."
  1. D ^DIR
  1. I $D(DIRUT)!(Y="") Q ""
  1. Q Y
  1. ;
  1. ; *** BEGIN HL*1.6*147 - RBN
  1. ;
  1. ASKSCR() ;
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. N DIR
  1. S DIR(0)="PO^779.11"
  1. S DIR("A")="Error Screen (optional)"
  1. S DIR("B")=""
  1. S DIR("?")="Enter the full name of the error screen. This entry is optional"
  1. D ^DIR
  1. I $D(DIRUT)!'(Y>0) Q ""
  1. Q Y
  1. ;
  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. RJ(STRING,LEN) ;
  1. Q $$RJ^XLFSTR(STRING,LEN)
  1. ;
  1. I() ;
  1. S VALMCNT=VALMCNT+1
  1. Q VALMCNT
  1. ;
  1. Q
  1. HELP ;
  1. N ARY
  1. S ARY(1)="An error screen allows you to specify what type of errors"
  1. S ARY(2)="appear in the error display. There are two types of screens:"
  1. S ARY(3)=""
  1. S ARY(4)="EXCLUDE screens allow you to specify what errors to exclude from the display."
  1. S ARY(5)=""
  1. S ARY(6)="INCLUDE screens allow you to specify what errors to include in the display."
  1. S ARY(7)=""
  1. S ARY(8)="With either type of screen, if a string on your list matches text within"
  1. S ARY(9)="the error message then the error is included or excluded from the"
  1. S ARY(10)="display, depending on the type of screen."
  1. D EN^DDIOL(.ARY)
  1. Q
  1. ;
  1. GETSCRN(IEN,SCREEN) ;
  1. ;pass SCREEN by reference
  1. ;returns 1 on success, 0 on failure
  1. ;
  1. N NODE,TYPE,I,ERROR
  1. K SCREEN
  1. S NODE=$G(^HLD(779.11,IEN,0))
  1. S TYPE=$P(NODE,"^",5)
  1. I TYPE'=0,TYPE'=1 Q 0
  1. S SCREEN("TYPE")=$S(TYPE=0:"EXCLUDE",1:"INCLUDE")
  1. S SCREEN("IEN")=IEN
  1. S I=0
  1. F S I=$O(^HLD(779.11,IEN,1,I)) Q:'I S ERROR=$G(^HLD(779.11,IEN,1,I,0)) I ERROR'="" S SCREEN("ERRORS",I)=$P(ERROR,"^"),SCREEN("ERRORS",I,"PARTIAL")=+$P(ERROR,"^",2)
  1. Q 1
  1. SCREEN(ERROR,SCREEN) ;
  1. ;Returns 1 if the ERROR should be added to the display based on the SCREEN
  1. ;
  1. I ERROR="" Q $S(SCREEN("TYPE")="EXCLUDE":1,1:0)
  1. ;
  1. N ADD,I,TEXT
  1. ;
  1. S I=0
  1. S ADD=$S(SCREEN("TYPE")="INCLUDE":0,1:1)
  1. ;
  1. F S I=$O(SCREEN("ERRORS",I)) Q:'I S TEXT=$G(SCREEN("ERRORS",I)) I $L(TEXT),$S(SCREEN("ERRORS",I,"PARTIAL"):ERROR[TEXT,1:TEXT=ERROR) S ADD=$S(SCREEN("TYPE")="INCLUDE":1,1:0) Q
  1. ;
  1. Q ADD