- HLOUSR2 ;ALB/CJM -ListManager Screen for viewing message errors;12 JUN 1997 10:00 am ;07/27/2010
- ;;1.6;HEALTH LEVEL SEVEN;**126,134,137,138,147**;Oct 13, 1995;Build 15
- ;Per VHA Directive 2004-038, this routine should not be modified
- ;
- EN ;
- D WAIT^DICD
- D EN^VALM("HLO MESSAGE VIEWER")
- Q
- ;
- SHOWLIST ;
- N PARMS,I,ERRCOUNT,SCREEN
- S (VALMBG,VALMCNT,I,ERRCOUNT,SCREEN)=0
- D CLEAN^VALM10
- S VALMBG=1
- I '$$ASKPARMS(.PARMS) S VALMBCK="" Q
- ;
- I PARMS("SCR") S SCREEN=$$GETSCRN(+PARMS("SCR"),.SCREEN)
- I PARMS("ALL") D
- .N APP
- .S APP=""
- .F S APP=$O(^HLB("ERRORS",APP)) Q:APP="" D Q:ERRCOUNT>PARMS("MAX")
- ..N TIME,IEN
- ..S TIME=PARMS("START")
- ..Q:($O(^HLB("ERRORS",APP,TIME))="")
- ..S @VALMAR@($$I,0)="Application: "_APP
- ..D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
- ..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")
- E D
- .N APP
- .S APP=PARMS("APP")
- .N TIME,IEN
- .S TIME=PARMS("START")
- .Q:$O(^HLB("ERRORS",APP,TIME))=""
- .S @VALMAR@($$I,0)="Application: "_APP
- .D CNTRL^VALM10(VALMCNT,14,$L(APP),IOINHI,IOINORM)
- .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")
- SHOW S VALMBCK="R"
- ;
- Q
- ADDTO(IEN,TIME,SCREEN,ERRCOUNT) ;
- N NODE,MSG,LIST,SKIP
- Q:'$$STARTMSG^HLOPRS(.MSG,+IEN)
- ;S ERRCOUNT=ERRCOUNT+1
- ;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)
- S ERRTEXT=MSG("STATUS","ERROR TEXT")
- I ERRTEXT="",MSG("ACK BY")]"",($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1) D
- .N MSG,SEG,FS,AIEN
- .S AIEN=+LIST(1),SUBIEN=$P(LIST(1),"^",2)
- .Q:'$$STARTMSG^HLOPRS(.MSG,AIEN)
- .I SUBIEN S MSG("BATCH","CURRENT MESSAGE")=SUBIEN,MSG("LINE COUNT")=0
- .; ** Start HL*1.6*138 PIJ **
- .;;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
- .F Q:'$$HLNEXT^HLOMSG(.MSG,.SEG) I $E(SEG(1),1,3)="MSA" S MSA=SEG(1),FS=$E(MSA,4) D Q
- ..S ERRTEXT=$$ESCAPE^HLOPBLD(.MSG,$P(MSA,FS,4))
- .; ** End HL*1.6*138 **
- I ERRTEXT="",MSG("ACK BY")="" D
- .N FS
- .S FS=$E(MSG("HDR",1),4)
- .I $L(FS) S ERRTEXT=$P($G(MSG("STATUS","ACCEPT ACK MSA")),FS,4)
- I SCREEN,'$$SCREEN(ERRTEXT,.SCREEN) Q
- S ERRCOUNT=ERRCOUNT+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)
- D CNTRL^VALM10(VALMCNT,3,25,IOINHI,IOINORM)
- I $L(ERRTEXT)>35 D
- .S @VALMAR@($$I,0)=$$RJ(" ",45)_$E(ERRTEXT,36,115)
- 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("MAX")=$$ASKMAX()
- Q:'(PARMS("MAX")>-1) 0
- S PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
- ;
- ; *** BEGIN HL*1.6*147 - RBN
- ;
- ;I PARMS("ALL") Q 1
- I PARMS("ALL")="" Q 0
- ;S PARMS("APP")=$$ASKAPP()
- I 'PARMS("ALL") D Q:PARMS("APP")="" 0
- . S PARMS("APP")=$$ASKAPP()
- S PARMS("SCR")=$$ASKSCR()
- ;
- ; ** END HL*1.6*147 - RBN
- ;
- Q 1
- ;
- ASKMAX() ;
- N DIR
- S DIR(0)="N^1:30000:0"
- S DIR("A")="Maximum List Size"
- S DIR("B")=1000
- S DIR("?",1)="In case a large number of errors meet your search criteria, what are the"
- S DIR("?")="maximum number of errors to display? (30,000 maximum)"
- D ^DIR
- Q:$D(DTOUT)!$D(DUOUT) -1
- Q X-1
- ;
- ASKAPP() ;
- D FULL^VALM1
- S VALMBCK="R"
- N DIR
- S DIR(0)="F^3:60"
- S DIR("A")="Receiving Application"
- S DIR("?")="Enter the full name of the application, or '^' to exit."
- D ^DIR
- I $D(DIRUT)!(Y="") Q ""
- Q Y
- ;
- ; *** BEGIN HL*1.6*147 - RBN
- ;
- ASKSCR() ;
- D FULL^VALM1
- S VALMBCK="R"
- N DIR
- S DIR(0)="PO^779.11"
- S DIR("A")="Error Screen (optional)"
- S DIR("B")=""
- S DIR("?")="Enter the full name of the error screen. This entry is optional"
- D ^DIR
- I $D(DIRUT)!'(Y>0) 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)
- RJ(STRING,LEN) ;
- Q $$RJ^XLFSTR(STRING,LEN)
- ;
- I() ;
- S VALMCNT=VALMCNT+1
- Q VALMCNT
- ;
- Q
- HELP ;
- N ARY
- S ARY(1)="An error screen allows you to specify what type of errors"
- S ARY(2)="appear in the error display. There are two types of screens:"
- S ARY(3)=""
- S ARY(4)="EXCLUDE screens allow you to specify what errors to exclude from the display."
- S ARY(5)=""
- S ARY(6)="INCLUDE screens allow you to specify what errors to include in the display."
- S ARY(7)=""
- S ARY(8)="With either type of screen, if a string on your list matches text within"
- S ARY(9)="the error message then the error is included or excluded from the"
- S ARY(10)="display, depending on the type of screen."
- D EN^DDIOL(.ARY)
- Q
- ;
- GETSCRN(IEN,SCREEN) ;
- ;pass SCREEN by reference
- ;returns 1 on success, 0 on failure
- ;
- N NODE,TYPE,I,ERROR
- K SCREEN
- S NODE=$G(^HLD(779.11,IEN,0))
- S TYPE=$P(NODE,"^",5)
- I TYPE'=0,TYPE'=1 Q 0
- S SCREEN("TYPE")=$S(TYPE=0:"EXCLUDE",1:"INCLUDE")
- S SCREEN("IEN")=IEN
- S I=0
- 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)
- Q 1
- SCREEN(ERROR,SCREEN) ;
- ;Returns 1 if the ERROR should be added to the display based on the SCREEN
- ;
- I ERROR="" Q $S(SCREEN("TYPE")="EXCLUDE":1,1:0)
- ;
- N ADD,I,TEXT
- ;
- S I=0
- S ADD=$S(SCREEN("TYPE")="INCLUDE":0,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
- ;
- Q ADD
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOUSR2 9113 printed Feb 18, 2025@23:25:43 Page 2
- 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
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- +3 ;
- EN ;
- +1 DO WAIT^DICD
- +2 DO EN^VALM("HLO MESSAGE VIEWER")
- +3 QUIT
- +4 ;
- SHOWLIST ;
- +1 NEW PARMS,I,ERRCOUNT,SCREEN
- +2 SET (VALMBG,VALMCNT,I,ERRCOUNT,SCREEN)=0
- +3 DO CLEAN^VALM10
- +4 SET VALMBG=1
- +5 IF '$$ASKPARMS(.PARMS)
- SET VALMBCK=""
- QUIT
- +6 ;
- +7 IF PARMS("SCR")
- SET SCREEN=$$GETSCRN(+PARMS("SCR"),.SCREEN)
- +8 IF PARMS("ALL")
- Begin DoDot:1
- +9 NEW APP
- +10 SET APP=""
- +11 FOR
- SET APP=$ORDER(^HLB("ERRORS",APP))
- if APP=""
- QUIT
- Begin DoDot:2
- +12 NEW TIME,IEN
- +13 SET TIME=PARMS("START")
- +14 if ($ORDER(^HLB("ERRORS",APP,TIME))="")
- QUIT
- +15 SET @VALMAR@($$I,0)="Application: "_APP
- +16 DO CNTRL^VALM10(VALMCNT,14,$LENGTH(APP),IOINHI,IOINORM)
- +17 FOR
- SET TIME=$ORDER(^HLB("ERRORS",APP,TIME))
- if 'TIME
- QUIT
- if ERRCOUNT>PARMS("MAX")
- QUIT
- SET IEN=""
- FOR
- SET IEN=$ORDER(^HLB("ERRORS",APP,TIME,IEN))
- if IEN=""
- QUIT
- DO ADDTO(IEN,TIME,.SCREEN,.ERRCOUNT)
- if ERRCOUNT>PARMS("MAX")
- QUIT
- End DoDot:2
- if ERRCOUNT>PARMS("MAX")
- QUIT
- End DoDot:1
- +18 IF '$TEST
- Begin DoDot:1
- +19 NEW APP
- +20 SET APP=PARMS("APP")
- +21 NEW TIME,IEN
- +22 SET TIME=PARMS("START")
- +23 if $ORDER(^HLB("ERRORS",APP,TIME))=""
- QUIT
- +24 SET @VALMAR@($$I,0)="Application: "_APP
- +25 DO CNTRL^VALM10(VALMCNT,14,$LENGTH(APP),IOINHI,IOINORM)
- +26 FOR
- SET TIME=$ORDER(^HLB("ERRORS",APP,TIME))
- if 'TIME
- QUIT
- if ERRCOUNT>PARMS("MAX")
- QUIT
- SET IEN=""
- FOR
- SET IEN=$ORDER(^HLB("ERRORS",APP,TIME,IEN))
- if IEN=""
- QUIT
- DO ADDTO(IEN,TIME,.SCREEN,.ERRCOUNT)
- if ERRCOUNT>PARMS("MAX")
- QUIT
- End DoDot:1
- SHOW SET VALMBCK="R"
- +1 ;
- +2 QUIT
- ADDTO(IEN,TIME,SCREEN,ERRCOUNT) ;
- +1 NEW NODE,MSG,LIST,SKIP
- +2 if '$$STARTMSG^HLOPRS(.MSG,+IEN)
- QUIT
- +3 ;S ERRCOUNT=ERRCOUNT+1
- +4 ;application errors could be an error to a msg within a batch
- +5 ;also, need to go to the ack msg to get the error text from the MSA segment
- +6 ;
- +7 NEW SUBIEN,MSA,ERRTEXT
- +8 SET (ERRTEXT,MSA)=""
- +9 SET SUBIEN=$PIECE(IEN,"^",2)
- +10 ;within batch?
- +11 if SUBIEN
- DO GETMSGB^HLOMSG1(.MSG,SUBIEN,.MSG)
- +12 SET ERRTEXT=MSG("STATUS","ERROR TEXT")
- +13 IF ERRTEXT=""
- IF MSG("ACK BY")]""
- IF ($$FINDMSG^HLOMSG1(MSG("ACK BY"),.LIST)=1)
- Begin DoDot:1
- +14 NEW MSG,SEG,FS,AIEN
- +15 SET AIEN=+LIST(1)
- SET SUBIEN=$PIECE(LIST(1),"^",2)
- +16 if '$$STARTMSG^HLOPRS(.MSG,AIEN)
- QUIT
- +17 IF SUBIEN
- SET MSG("BATCH","CURRENT MESSAGE")=SUBIEN
- SET MSG("LINE COUNT")=0
- +18 ; ** Start HL*1.6*138 PIJ **
- +19 ;;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
- +20 FOR
- if '$$HLNEXT^HLOMSG(.MSG,.SEG)
- QUIT
- IF $EXTRACT(SEG(1),1,3)="MSA"
- SET MSA=SEG(1)
- SET FS=$EXTRACT(MSA,4)
- Begin DoDot:2
- +21 SET ERRTEXT=$$ESCAPE^HLOPBLD(.MSG,$PIECE(MSA,FS,4))
- End DoDot:2
- QUIT
- +22 ; ** End HL*1.6*138 **
- End DoDot:1
- +23 IF ERRTEXT=""
- IF MSG("ACK BY")=""
- Begin DoDot:1
- +24 NEW FS
- +25 SET FS=$EXTRACT(MSG("HDR",1),4)
- +26 IF $LENGTH(FS)
- SET ERRTEXT=$PIECE($GET(MSG("STATUS","ACCEPT ACK MSA")),FS,4)
- End DoDot:1
- +27 IF SCREEN
- IF '$$SCREEN(ERRTEXT,.SCREEN)
- QUIT
- +28 SET ERRCOUNT=ERRCOUNT+1
- +29 SET @VALMAR@($$I,0)=" "_$$LJ(MSG("ID"),25)_$SELECT(MSG("BATCH"):"BATCH ",1:$$LJ($GET(MSG("MESSAGE TYPE"))_"~"_$GET(MSG("EVENT")),8))_$$LJ($$FMTE^XLFDT(MSG("DT/TM CREATED"),2),20)_$EXTRACT(ERRTEXT,1,35)
- +30 DO CNTRL^VALM10(VALMCNT,3,25,IOINHI,IOINORM)
- +31 IF $LENGTH(ERRTEXT)>35
- Begin DoDot:1
- +32 SET @VALMAR@($$I,0)=$$RJ(" ",45)_$EXTRACT(ERRTEXT,36,115)
- End DoDot:1
- +33 if MSG("ID")]""
- SET @VALMAR@("INDEX",MSG("ID"))=IEN
- +34 QUIT
- +35 ;
- ASKPARMS(PARMS) ;
- +1 KILL PARMS
- +2 SET PARMS("START")=$$ASKBEGIN("T-1")
- +3 IF 'PARMS("START")
- QUIT 0
- +4 SET PARMS("MAX")=$$ASKMAX()
- +5 if '(PARMS("MAX")>-1)
- QUIT 0
- +6 SET PARMS("ALL")=$$ASKYESNO("Include ALL applications","YES")
- +7 ;
- +8 ; *** BEGIN HL*1.6*147 - RBN
- +9 ;
- +10 ;I PARMS("ALL") Q 1
- +11 IF PARMS("ALL")=""
- QUIT 0
- +12 ;S PARMS("APP")=$$ASKAPP()
- +13 IF 'PARMS("ALL")
- Begin DoDot:1
- +14 SET PARMS("APP")=$$ASKAPP()
- End DoDot:1
- if PARMS("APP")=""
- QUIT 0
- +15 SET PARMS("SCR")=$$ASKSCR()
- +16 ;
- +17 ; ** END HL*1.6*147 - RBN
- +18 ;
- +19 QUIT 1
- +20 ;
- ASKMAX() ;
- +1 NEW DIR
- +2 SET DIR(0)="N^1:30000:0"
- +3 SET DIR("A")="Maximum List Size"
- +4 SET DIR("B")=1000
- +5 SET DIR("?",1)="In case a large number of errors meet your search criteria, what are the"
- +6 SET DIR("?")="maximum number of errors to display? (30,000 maximum)"
- +7 DO ^DIR
- +8 if $DATA(DTOUT)!$DATA(DUOUT)
- QUIT -1
- +9 QUIT X-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")="Receiving Application"
- +6 SET DIR("?")="Enter the full name of the application, or '^' to exit."
- +7 DO ^DIR
- +8 IF $DATA(DIRUT)!(Y="")
- QUIT ""
- +9 QUIT Y
- +10 ;
- +11 ; *** BEGIN HL*1.6*147 - RBN
- +12 ;
- ASKSCR() ;
- +1 DO FULL^VALM1
- +2 SET VALMBCK="R"
- +3 NEW DIR
- +4 SET DIR(0)="PO^779.11"
- +5 SET DIR("A")="Error Screen (optional)"
- +6 SET DIR("B")=""
- +7 SET DIR("?")="Enter the full name of the error screen. This entry is optional"
- +8 DO ^DIR
- +9 IF $DATA(DIRUT)!'(Y>0)
- QUIT ""
- +10 QUIT Y
- +11 ;
- +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)
- RJ(STRING,LEN) ;
- +1 QUIT $$RJ^XLFSTR(STRING,LEN)
- +2 ;
- I() ;
- +1 SET VALMCNT=VALMCNT+1
- +2 QUIT VALMCNT
- +3 ;
- +1 QUIT
- HELP ;
- +1 NEW ARY
- +2 SET ARY(1)="An error screen allows you to specify what type of errors"
- +3 SET ARY(2)="appear in the error display. There are two types of screens:"
- +4 SET ARY(3)=""
- +5 SET ARY(4)="EXCLUDE screens allow you to specify what errors to exclude from the display."
- +6 SET ARY(5)=""
- +7 SET ARY(6)="INCLUDE screens allow you to specify what errors to include in the display."
- +8 SET ARY(7)=""
- +9 SET ARY(8)="With either type of screen, if a string on your list matches text within"
- +10 SET ARY(9)="the error message then the error is included or excluded from the"
- +11 SET ARY(10)="display, depending on the type of screen."
- +12 DO EN^DDIOL(.ARY)
- +13 QUIT
- +14 ;
- GETSCRN(IEN,SCREEN) ;
- +1 ;pass SCREEN by reference
- +2 ;returns 1 on success, 0 on failure
- +3 ;
- +4 NEW NODE,TYPE,I,ERROR
- +5 KILL SCREEN
- +6 SET NODE=$GET(^HLD(779.11,IEN,0))
- +7 SET TYPE=$PIECE(NODE,"^",5)
- +8 IF TYPE'=0
- IF TYPE'=1
- QUIT 0
- +9 SET SCREEN("TYPE")=$SELECT(TYPE=0:"EXCLUDE",1:"INCLUDE")
- +10 SET SCREEN("IEN")=IEN
- +11 SET I=0
- +12 FOR
- SET I=$ORDER(^HLD(779.11,IEN,1,I))
- if 'I
- QUIT
- SET ERROR=$GET(^HLD(779.11,IEN,1,I,0))
- IF ERROR'=""
- SET SCREEN("ERRORS",I)=$PIECE(ERROR,"^")
- SET SCREEN("ERRORS",I,"PARTIAL")=+$PIECE(ERROR,"^",2)
- +13 QUIT 1
- SCREEN(ERROR,SCREEN) ;
- +1 ;Returns 1 if the ERROR should be added to the display based on the SCREEN
- +2 ;
- +3 IF ERROR=""
- QUIT $SELECT(SCREEN("TYPE")="EXCLUDE":1,1:0)
- +4 ;
- +5 NEW ADD,I,TEXT
- +6 ;
- +7 SET I=0
- +8 SET ADD=$SELECT(SCREEN("TYPE")="INCLUDE":0,1:1)
- +9 ;
- +10 FOR
- SET I=$ORDER(SCREEN("ERRORS",I))
- if 'I
- QUIT
- SET TEXT=$GET(SCREEN("ERRORS",I))
- IF $LENGTH(TEXT)
- IF $SELECT(SCREEN("ERRORS",I,"PARTIAL"):ERROR[TEXT,1:TEXT=ERROR)
- SET ADD=$SELECT(SCREEN("TYPE")="INCLUDE":1,1:0)
- QUIT
- +11 ;
- +12 QUIT ADD