Routine: HLOTRACE

HLOTRACE ;OIFO-OAK/PIJ/CJM - HLO CLIENT TRACE Tool ; 03/07/2011

 ;;1.6;HEALTH LEVEL SEVEN;**146,147,153,172** ;Oct 13, 1995;Build 11

 ;Per VA Directive 6402, this routine should not be modified.

;;

 ;; HLO CLIENT TRACE Tool

 ;; *** For troubleshooting HLO client issues ***

 ;;     Client runs in the foreground and writes trace statements

 ;;     to the screen.

;;

START ;

 N CONF

 I '$G(DUZ) W !,"Your DUZ must be set!" Q

 D OWNSKEY^XUSRB(.CONF,"XUPROG",DUZ)

 I 'CONF(0) D  Q

 . W !!,"   Sorry, you are not authorized to use this tool.",!!

 ;I $P($$VERSION^%ZOSV(1),"/",1)'="Cache for OpenVMS" D  Q

 I '(($P($$VERSION^%ZOSV(1),"/",1)[("Cache"))!($$VERSION^%ZOSV(1)["IRIS")) D  Q

 .W !!,"   Sorry, this tool can only be used under Cache or IRIS",!!

 N LINK,PORT,QUE,SUB,WORK,HLMSTATE,HLCSTATE,OLD,MAXTRACE,TRACECNT

 S LINK=$$ASKLINK^HLOUSR

 Q:LINK=""

 S PORT=$$ASKPORT(LINK)

 Q:'PORT

 S SUB=LINK_":"_PORT

 S QUE=$$ASKQUE(SUB)

 Q:QUE=""

 ZB /INTERRUPT:NORMAL ;disable CTRL-C breaks

 L +^HLB("QUEUE","OUT",SUB,QUE):20

 I '$T W !,"That queue is currently being processed. You need to either stop that link,",!,"stop that queue, or totally stop HLO so that this tool can be used." Q

 I '$O(^HLB("QUEUE","OUT",SUB,QUE,0)) W !,"There are no messages pending on that queue!" Q

 S TRACECNT=0

 S MAXTRACE=$$ASKCOUNT

 Q:(MAXTRACE<1)

 S WORK("QUEUE")=QUE,WORK("LINK")=SUB

 D SETBREAKS

 D DOWORK^HLOCLNT(.WORK)

 D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)

 U $PRINCIPAL

 L -^HLB("QUEUE","OUT",SUB,QUE)

 ZB /CLEAR

 W !,"DONE!"

SETBREAKS ;

 ZB /CLEAR

 ;set break in $$STOPPED^HLOQUE to circumvent shutdown of the queue

 ZB ZB0^HLOQUE:"N":1:"S RET=0"

 ;set break in $$IFSHUT^HLOTLNK to circumvent shutdown of the link

 ZB ZB0^HLOTLNK:"N":1:"S RET=0"

 ;set break at ZB0 in client (start of DOWORK)

 ZB ZB0^HLOCLNT:"N":1:"D WRITE^HLOTRACE(""Launching the client process..."")"

 ;set break at ZB1 in client ($$CONNECT)

 ZB ZB1^HLOCLNT1:"N":1:"D WRITE^HLOTRACE(""Trying to connect..."")"

 ;set break at ZB2 in client (end of $$CONNECT)

 ZB ZB2^HLOCLNT1:"N":1:"D ZB2^HLOTRACE"

 ;set break at ZB3 in client (ERROR TRAP)

 ZB ZB3^HLOCLNT:"N":1:"D ZB3^HLOTRACE"

 ;set break at ZB4 in client (FOR loop on the outgoing queue)

 ZB ZB4^HLOCLNT:"N":1:"D ZB4^HLOTRACE"

 ;set break at ZB5 in client (end of DOWORK, with just cleanup left)

 ZB ZB5^HLOCLNT:"N":1:"D WRITE3^HLOTRACE(""Cleaning up...."")"

 ;set break at ZB6 in client (start of $$TRANSMIT^HLOCLNT1)

 ZB ZB6^HLOCLNT1:"N":1:"D WRITE^HLOTRACE(""Beginning to transmit message...."")"

 ;set break at ZB7 in client (end of $$TRANSMIT^HLOCLNT1)

 ZB ZB7^HLOCLNT1:"N":1:"D WRITE^HLOTRACE(""Message transmitted!"")"

 ;set break at ZB8 in client (start of $$READACK^HLOCLNT1)

 ;ZB ZB8^HLOCLNT1:"N":1:"D WRITE^HLOTRACE(""Beginning to read commit acknowledgment...."")"

 ZB ZB8^HLOCLNT1:"N":1:"D ZB8^HLOTRACE"

 ;set break at ZB9 in client (end of $$READACK^HLOCLNT1)

 ;ZB ZB9^HLOCLNT1:"N":1:"D WRITE^HLOTRACE(""Commit acknowledgment received!"")"

 ZB ZB9^HLOCLNT1:"N":1:"D ZB9^HLOTRACE"

 ;set break ZB10 in the client(start of $$READHDR^HLOT)

 ZB ZB10^HLOT:"N":1:"D ZB10^HLOTRACE"

 ;set break ZB11 in the client(end of $$READHDR^HLOT)

 ZB ZB11^HLOT:"N":1:"D ZB11^HLOTRACE"

 ;set break ZB12 in the client(start of $$READSEG^HLOT)

 ZB ZB12^HLOT:"N":1:"D ZB12^HLOTRACE"

 ;set break ZB13 in the client(end of $$READSEG^HLOT)

 ZB ZB13^HLOT:"N":1:"D ZB13^HLOTRACE"

 ;set break ZB14 in the client(start of $$WRITESEG^HLOT)

 ZB ZB14^HLOT:"N":1:"D ZB14^HLOTRACE"

 ;set break ZB15 in the client(end of $$WRITESEG^HLOT)

 ZB ZB15^HLOT:"N":1:"D ZB15^HLOTRACE"

 ;set break ZB16 in the client(start of $$WRITEHDR^HLOT)

 ZB ZB16^HLOT:"N":1:"D ZB16^HLOTRACE"

 ;set break ZB17 in the client(end of $$WRITEHDR^HLOT)

 ZB ZB17^HLOT:"N":1:"D ZB17^HLOTRACE"

 ;set break ZB18 in the client(start of $$ENDMSG^HLOT)

 ZB ZB18^HLOT:"N":1:"D ZB18^HLOTRACE"

 ;set break ZB19 in the client(end of $$ENDMSG^HLOT)

 ZB ZB19^HLOT:"N":1:"D ZB19^HLOTRACE"

 ZB ZB20^HLOCLNT:"N":1:"D ZB20^HLOTRACE"

 ZB ZB21^HLOCLNT:"N":1:"D ZB21^HLOTRACE"

 ZB ZB22^HLOCLNT:"N":1:"D ZB22^HLOTRACE"

 ZB ZB23^HLOCLNT:"N":1:"D ZB23^HLOTRACE"

 ZB ZB24^HLOCLNT1:"N":1:"D ZB24^HLOTRACE"

 ZB ZB25^HLOCLNT:"N":1:"D WRITE^HLOTRACE(""Calling DEQUE..."")"

 ZB ZB31^HLOTCP:"N":1:"D WRITE^HLOTRACE(""Beginning READ over TCP..."")"

 ZB ZB32^HLOTCP:"N":1:"D ZB32^HLOTRACE"

WRITE(MSG) ;

 N OLD

 S OLD=$IO

 U $PRINCIPAL

 W !,?5,"Time: ",$$NOW^XLFDT,"   ",MSG

 U OLD

WRITE2(MSG,VALUE) ;

 N OLD,I

 S OLD=$IO

 U $PRINCIPAL

 W !,?5,"Time: ",$$NOW^XLFDT,"   ",MSG

 S I=0

 W:$O(VALUE(0)) !

 F  S I=$O(VALUE(I)) Q:'I  W VALUE(I)

 U OLD

WRITE3(MSG) ;

 N OLD

 S OLD=$IO

 U $PRINCIPAL

 W !,MSG

 U OLD

ZB3 ;

 N CON,MSG

 S CON=($ZA\8192#2)

 S MSG="Error encountered, $ECODE="_$ECODE

 D WRITE^HLOTRACE(MSG)

 S MSG=$S(CON:"           TCP connection still active",1:"          TCP connection was dropped")

 D WRITE3^HLOTRACE(MSG)

 D ^%ZTER

ZB4 ;

 N OLD

 S OLD=$IO

 U $PRINCIPAL

 W !!,"Looking for the next message to transmit..."

 I 'MSGIEN W !!,"No more messages pending on that queue!" S SUCCESS=0 Q

 S TRACECNT=$G(TRACECNT)+1

 I MAXTRACE>1 D

 .W !!,"Message IEN=",MSGIEN," next on queue"

 .I TRACECNT>MAXTRACE D

 ..I $$ASKYESNO^HLOUSR2("Do you want to trace another group of message transmissions","YES") S SUCCESS=1,TRACECNT=1

 ..E  S SUCCESS=0

 .E  S SUCCESS=1

 E  D

 .I '$$ASKYESNO^HLOUSR2("Message IEN="_MSGIEN_" next on queue, do you want to trace its transmission","YES") S SUCCESS=0

 U OLD

ZB2 ;

 W !,$S('HLCSTATE("CONNECTED"):"Connection Failed!",1:"Connected!")

ZB8 ;

 D WRITE^HLOTRACE("Beginning to read commit acknowledgment....")

ZB9 ;

 I $G(SUCCESS) D

 .D WRITE^HLOTRACE("Commit acknowledgment received!")

 E  D

 .D WRITE^HLOTRACE("Read of commit acknowledgment FAILED!")

ZB10 ;

 D WRITE^HLOTRACE("Getting message header...")

ZB11 ;

 I $D(HDR) D WRITE2^HLOTRACE("",.HDR)

 D WRITE^HLOTRACE($S(SUCCESS:"Got message header!",1:"**** FAILED TO READ MESSAGE HEADER! *****"))

ZB12 ;

 D WRITE^HLOTRACE("Getting next segment...")

ZB13 I $D(SEG) D WRITE2^HLOTRACE("",.SEG)

 D WRITE^HLOTRACE($S(RETURN:"Got next segment!",$G(HLCSTATE("MESSAGE ENDED")):"No more segments!",1:"**** FAILED TO COMPLETE READING NEXT SEGMENT *****"))

ZB14 ;

 D WRITE2^HLOTRACE("Writing next segment...",.SEG)

ZB15 D WRITE^HLOTRACE($S(RETURN:"Completed!",1:"**** FAILED TO COMPLETE *****"))

ZB16 ;

 D WRITE2^HLOTRACE("Writing header segment...",.HDR)

ZB17 D WRITE^HLOTRACE($S(SUCCESS:"Completed!",1:"**** FAILED TO COMPLETE *****"))

ZB18 ;

 D WRITE^HLOTRACE("Writing message terminators and flushing buffer...")

ZB19 D WRITE^HLOTRACE($S(RETURN:"Completed!",1:"**** FAILED TO COMPLETE *****"))

ZB20 ;

 D WRITE^HLOTRACE("Message on queue was already transmitted, will be deleted from queue...")

ZB21 ;

 D WRITE^HLOTRACE("MSA segment shows this is not a commit ack to the message transmitted...")

ZB22 ;

 D WRITE^HLOTRACE("Commit ack not CA, message status set to error...")

ZB23 ;

 D WRITE^HLOTRACE("Setting timestamp of sequence queue...")

ZB24 ;S HLOCSTATE("CONNECTED")=1

 S HLCSTATE("LINK","SHUTDOWN")=0

ZB32 D:('$G(RETURN)) WRITE^HLOTRACE("**** FAILED ****")

 D:$G(RETURN) WRITE3^HLOTRACE("")

 D:$G(RETURN) WRITE3^HLOTRACE($G(BUF))

 D:$G(RETURN) WRITE3^HLOTRACE("")

 D:$G(RETURN) WRITE^HLOTRACE("READ over TCP completed! #Characters read: "_$L($G(BUF)))

ASKQUE(SUB) ;

 N DIR,Q1,Q2

 S Q1=$O(^HLB("QUEUE","OUT",SUB,""))

 I Q1="" W !,"There are no outgoing messages queued to that link!",! Q ""

 S Q2=$O(^HLB("QUEUE","OUT",SUB,Q1))

 I Q2="" D

 .S DIR("B")=Q1

 E  I $D(^HLB("QUEUE","OUT",SUB,"DEFAULT")) D

 .S DIR("B")="DEFAULT"

 E  D

 .S DIR("B")=Q1

 S DIR(0)="F^1:20"

 S DIR("A")="What is the name of the queue"

 S DIR("?",1)="To use this tool, there must be messages already pending transmission."

 S DIR("?")="Enter the name of the queue, or '^' to exit."

 D ^DIR

 I $D(DIRUT)!(Y="") Q ""

Q Y

ASKCOUNT() ;

 N DIR

 S DIR(0)="N^1:100"

 S DIR("A")="Send how many at a time"

 S DIR("B")=1

 S DIR("?",1)="How many messages do you want to transmit at once"

 S DIR("?")="while tracing the client (100 maximum)?"

 D ^DIR

 Q:$D(DTOUT)!$D(DUOUT) -1

Q X

ASKPORT(LINK) ;

 Q:LINK="" ""

 N PORT,QUEUE

 S QUEUE=$O(^HLB("QUEUE","OUT",LINK_":"))

 Q:$P(QUEUE,":")'=LINK ""

 S PORT=$P(QUEUE,":",2)

 Q:'PORT ""

 S QUEUE=$O(^HLB("QUEUE","OUT",QUEUE))

 Q:$P(QUEUE,":")'=LINK PORT

 S PORT=$$ASKPORT^HLOUSRA(LINK)

 Q PORT

HLOTRACE.m