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

HLOSTRAC.m

Go to the documentation of this file.
  1. HLOSTRAC ;OIFO-OAK/RBN/CJM - HLO SERVER TRACE Tool ; 02/22/2011
  1. ;;1.6;HEALTH LEVEL SEVEN;**146,147,153,172**;Oct 13, 1995;Build 11
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;;
  1. ;; HLO SERVER TRACE Tool
  1. ;; *** For troubleshooting HLO server issues ***
  1. ;; The HLO server runs in the foreground and writes trace
  1. ;; statements to the screen.
  1. ;;
  1. TRACE ;
  1. N CONF,HLOTRACE
  1. S HLOTRACE("COUNT")=0
  1. S HLOTRACE("ERRORS")=0
  1. I '$G(DUZ) W !,"Your DUZ must be set!" Q
  1. D OWNSKEY^XUSRB(.CONF,"XUPROG",DUZ)
  1. I 'CONF(0) D Q
  1. . W !!," Sorry, you are not authorized to use this tool.",!!
  1. I '(($P($$VERSION^%ZOSV(1),"/",1)[("Cache"))!($$VERSION^%ZOSV(1)["IRIS")) D Q D Q
  1. .W !!," Sorry, this tool can only be used under Cache or IRIS",!!
  1. N IEN,LINK,PORT
  1. S IEN=+$O(^HLD(779.1,0))
  1. D:IEN
  1. .S LINK=$P($G(^HLD(779.1,IEN,0)),"^",10)
  1. .S LINK=$P($G(^HLCS(870,LINK,0)),"^")
  1. S:'$L($G(LINK)) LINK="HLO DEFAULT LISTENER"
  1. W !,"What port do you want to listen on while in server trace mode?"
  1. W !,"The port must be free. If a server already has it opened then the"
  1. W !,"server needs to be stopped before starting in server trace mode."
  1. S PORT=$$ASKPORT^HLOUSRA(LINK)
  1. Q:'PORT
  1. D SETBREAKS
  1. ;
  1. ZB ZB999^HLOSRVR:"N":1:"S LINK(""PORT"")=PORT,LINK(""SERVER"")=""1^S"",LINK(""LLP"")=""TCP"""
  1. ;
  1. W !!,"Starting the server, hit the CTRL-C key to stop the server...",!!
  1. READ D
  1. .N $ETRAP,$ESTACK
  1. .S $ETRAP="G ERROR^HLOSTRAC"
  1. .D SERVER^HLOSRVR(LINK)
  1. .U $PRINCIPAL
  1. .W !,"DONE!"
  1. ZB /CLEAR
  1. Q
  1. ;
  1. SETBREAKS ;
  1. ZB /CLEAR
  1. ZB /INTERRUPT:NORMAL
  1. ;
  1. ;!!!! for debuggng only
  1. ;ZB ERROR^HLOSTRAC
  1. ;!!!!!!
  1. ;
  1. ;
  1. ;report errors
  1. ZB ZB1^HLOSRVR:"N":1:"S $ETRAP=""G ZB3^HLOSTRAC"""
  1. ;
  1. ;allow Server Trace tool to run even if HLO is shut down
  1. ZB ZB25^HLOPROC:"N":1:"S RET=0"
  1. ZB READMSG^HLOSRVR1:"N":1:"D READMSG^HLOSTRAC"
  1. ZB PARSEHDR^HLOPRS:"N":1:"D PARSEHDR^HLOSTRAC"
  1. ZB DUP^HLOSRVR1:"N":1:"D DUP^HLOSTRAC"
  1. ZB CLOSE^HLOT:"N":1:"D CLOSE^HLOSTRAC"
  1. ;set break ZB10 in the client(start of $$READHDR^HLOT)
  1. ZB ZB10^HLOT:"N":1:"D ZB10^HLOSTRAC"
  1. ;set break ZB11 in the client(end of $$READHDR^HLOT)
  1. ZB ZB11^HLOT:"N":1:"D ZB11^HLOSTRAC"
  1. ;set break ZB12 in the client(start of $$READSEG^HLOT)
  1. ZB ZB12^HLOT:"N":1:"D ZB12^HLOSTRAC"
  1. ;set break ZB13 in the client(end of $$READSEG^HLOT)
  1. ZB ZB13^HLOT:"N":1:"D ZB13^HLOSTRAC"
  1. ;set break ZB14 in the client(start of $$WRITESEG^HLOT)
  1. ZB ZB14^HLOT:"N":1:"D ZB14^HLOSTRAC"
  1. ;set break ZB15 in the client(end of $$WRITESEG^HLOT)
  1. ZB ZB15^HLOT:"N":1:"D ZB15^HLOSTRAC"
  1. ;set break ZB16 in the client(start of $$WRITEHDR^HLOT)
  1. ZB ZB16^HLOT:"N":1:"D ZB16^HLOSTRAC"
  1. ;set break ZB17 in the client(end of $$WRITEHDR^HLOT)
  1. ZB ZB17^HLOT:"N":1:"D ZB17^HLOSTRAC"
  1. ;set break ZB18 in the client(start of $$ENDMSG^HLOT)
  1. ZB ZB18^HLOT:"N":1:"D ZB18^HLOSTRAC"
  1. ;set break ZB19 in the server(end of $$ENDMSG^HLOT)
  1. ZB ZB19^HLOT:"N":1:"D ZB19^HLOSTRAC"
  1. ZB ZB25^HLOTCP:"N":1:"D ZB25^HLOSTRAC"
  1. ZB ZB26^HLOTCP:"N":1:"D ZB26^HLOSTRAC"
  1. ;
  1. ZB ZB27^HLOTCP:"N":1:"D ZB27^HLOSTRAC"
  1. ;
  1. ZB ZB28^HLOTCP:"N":1:"D ZB28^HLOSTRAC"
  1. ;set break ZB29 in the server(after parsing the message header)
  1. ZB ZB29^HLOSRVR1:"N":1:"D ZB29^HLOSTRAC"
  1. ;set break ZB30 in the server(afterchecking if duplicate)
  1. ZB ZB30^HLOSRVR1:"N":1:"D ZB30^HLOSTRAC"
  1. ZB ZB31^HLOTCP:"N":1:"D WRITE^HLOTRACE(""Beginning READ over TCP..."")"
  1. ZB ZB32^HLOTCP:"N":1:"D ZB32^HLOTRACE"
  1. Q
  1. ;
  1. WRITE(MSG) ;
  1. N OLD
  1. S OLD=$IO
  1. U $PRINCIPAL
  1. W !,?5,"Time: ",$$NOW^XLFDT," ",MSG
  1. U OLD
  1. Q
  1. WRITE2(MSG,VALUE) ;
  1. N OLD,I
  1. S OLD=$IO
  1. U $PRINCIPAL
  1. W !,?5,"Time: ",$$NOW^XLFDT," ",MSG
  1. S I=0
  1. W:$O(VALUE(0)) !
  1. F S I=$O(VALUE(I)) Q:'I W VALUE(I)
  1. U OLD
  1. Q
  1. WRITE3(MSG) ;
  1. N OLD
  1. S OLD=$IO
  1. U $PRINCIPAL
  1. W !,MSG
  1. U OLD
  1. Q
  1. READMSG ;
  1. ;
  1. S HLOTRACE("COUNT")=HLOTRACE("COUNT")+1
  1. S HLOTRACE("ERRORS")=0
  1. I HLOTRACE("COUNT")>10 D
  1. .N OLD,SEND
  1. .S OLD=$IO
  1. .U $PRINCIPAL
  1. .W !
  1. .S SEND=$$ASKYESNO^HLOUSR2("Do you want to trace more message transmissions","NO")
  1. .I 'SEND S $ECODE=",UHLOSTOP,"
  1. .U OLD
  1. W !
  1. D WRITE3^HLOSTRAC("Beginning to read next message...")
  1. Q
  1. PARSEHDR ;
  1. D WRITE^HLOSTRAC("Parsing the message header...")
  1. Q
  1. DUP ;
  1. D WRITE^HLOSTRAC("Checking if duplicate message...")
  1. Q
  1. CLOSE ;
  1. D WRITE^HLOSTRAC("Closing the port...")
  1. Q
  1. ;
  1. ERROR ;
  1. I ($ECODE["EDITED") Q:$QUIT "" Q
  1. I ($ECODE["ZINTERRUPT") Q:$QUIT "" Q
  1. D WRITE^HLOSTRAC("*** ERROR *** : "_$ECODE)
  1. S HLOTRACE("ERRORS")=HLOTRACE("ERRORS")+1
  1. I HLOTRACE("ERRORS")>5 Q:$QUIT "" Q
  1. S $ECODE=""
  1. G READ^HLOSTRAC
  1. Q:$QUIT "" Q
  1. Q
  1. ZB10 ;
  1. D WRITE^HLOSTRAC("Getting message header...")
  1. Q
  1. ZB11 I $D(HDR) D WRITE2^HLOSTRAC(" Header follows...",.HDR)
  1. D WRITE^HLOSTRAC($S(SUCCESS:"Got the header!",1:"**** FAILED TO COMPLETE *****"))
  1. Q
  1. ZB12 ;
  1. D WRITE^HLOSTRAC("Getting next segment...")
  1. Q
  1. ZB13 I $D(SEG) D WRITE2^HLOSTRAC(" Segment follows...",.SEG)
  1. D WRITE^HLOSTRAC($S(RETURN:"Got the segment!",$G(HLCSTATE("MESSAGE ENDED")):"No more segments!",1:"**** FAILED TO COMPLETE *****"))
  1. Q
  1. ZB14 ;
  1. D WRITE2^HLOSTRAC("Writing next segment...",.SEG)
  1. Q
  1. ZB15 D WRITE^HLOSTRAC($S(RETURN:"Completed!",1:"**** FAILED TO COMPLETE *****"))
  1. Q
  1. ZB16 ;
  1. D WRITE3^HLOSTRAC("Beginning to write the commit acknowledgment...")
  1. D WRITE2^HLOSTRAC("Writing header segment...",.HDR)
  1. Q
  1. ZB17 D WRITE^HLOSTRAC($S(SUCCESS:"Completed!",1:"**** FAILED TO COMPLETE *****"))
  1. Q
  1. ZB18 ;
  1. D WRITE^HLOSTRAC("Writing message terminators and flushing buffer...")
  1. Q
  1. ZB19 D WRITE^HLOSTRAC($S(RETURN:"Completed!",1:"**** FAILED TO COMPLETE *****"))
  1. Q
  1. ZB25 D WRITE^HLOSTRAC("Opening the port...")
  1. Q
  1. ZB26 D WRITE^HLOSTRAC("Waiting for remote client to connect...")
  1. Q
  1. ZB27 D WRITE^HLOSTRAC("Remote client connected...")
  1. Q
  1. ZB28 D:'$G(HLCSTATE("CONNECTED")) WRITE^HLOSTRAC("**** UNABLE TO OPEN PORT *****")
  1. Q
  1. ZB29 D WRITE3^HLOSTRAC("*** THE MESSAGE HEADER COULD NOT BE PARSED ***")
  1. Q
  1. ZB30 D WRITE3^HLOSTRAC("*** THE MESSAGE IS A DUPLICATE AND WILL BE DISCARDED ***")
  1. D WRITE3^HLOSTRAC("*** THE ORIGINAL COMMIT ACKNOWLEDMENT WILL BE RETURNED ***")
  1. Q
  1. ;
  1. ZB3 ;
  1. S $ETRAP="Q:$QUIT """" Q"
  1. D END^HLOSRVR
  1. N CON,MSG
  1. S CON=($ZA\8192#2)
  1. S MSG="Error encountered, $ECODE="_$ECODE
  1. D WRITE^HLOTRACE(MSG)
  1. S MSG=$S(CON:" TCP connection still active",1:" TCP connection was dropped")
  1. D WRITE3^HLOTRACE(MSG)
  1. I ($ECODE["EDITED") Q:$QUIT "" Q
  1. I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D
  1. .;
  1. E D
  1. .D ^%ZTER
  1. Q
  1. ZB32 D:('$G(RETURN)) WRITE^HLOTRACE("**** FAILED ****")
  1. D:$G(RETURN) WRITE3^HLOTRACE("")
  1. D:$G(RETURN) WRITE3^HLOTRACE($G(BUF))
  1. Q