| 1 | XOBVRH ;mjk/alb - VistaLink Request Handler Utilities ; 07/27/2002 13:00
|
|---|
| 2 | ;;1.5;VistALink;;Sep 09, 2005
|
|---|
| 3 | ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
|
|---|
| 4 | ;
|
|---|
| 5 | QUIT
|
|---|
| 6 | ;
|
|---|
| 7 | ; ------------------------------------------------------------------
|
|---|
| 8 | ; Message Type Handler Utilities
|
|---|
| 9 | ; ------------------------------------------------------------------
|
|---|
| 10 | ;
|
|---|
| 11 | ; -- set up msg type info using message name
|
|---|
| 12 | MSGNAME(XOBMSG,XOBHDLR) ; -- set up msg type info
|
|---|
| 13 | QUIT $$SETMSG(XOBMSG,"NAME",.XOBHDLR)
|
|---|
| 14 | ;
|
|---|
| 15 | ; -- set up msg type info using message type
|
|---|
| 16 | MSGTYPE(XOBMSG,XOBHDLR) ; -- set up msg type info
|
|---|
| 17 | QUIT $$SETMSG(XOBMSG,"MSGTYPE",.XOBHDLR)
|
|---|
| 18 | ;
|
|---|
| 19 | ; -- set up msg type info using proprietary string
|
|---|
| 20 | MSGSINK(XOBMSG,XOBHDLR) ; -- set up msg type info
|
|---|
| 21 | QUIT $$SETMSG(XOBMSG,"D",.XOBHDLR)
|
|---|
| 22 | ;
|
|---|
| 23 | CACHE(XOBHDLR) ; -- cache req handlers
|
|---|
| 24 | NEW TYPE,TYPE0,XOBOK
|
|---|
| 25 | SET TYPE=0
|
|---|
| 26 | SET XOBOK=1
|
|---|
| 27 | ;
|
|---|
| 28 | ; -- load request handler info
|
|---|
| 29 | FOR SET TYPE=$ORDER(^XOB(18.05,"AS",1,TYPE)) QUIT:'TYPE DO QUIT:'XOBOK
|
|---|
| 30 | . SET TYPE0=$GET(^XOB(18.05,TYPE,0))
|
|---|
| 31 | . DO SET(TYPE,TYPE0,.XOBHDLR)
|
|---|
| 32 | . SET XOBOK=$GET(XOBHDLR(TYPE))
|
|---|
| 33 | . IF 'XOBOK SET XOBOK=XOBOK_U_$GET(XOBHDLR,"ERROR")
|
|---|
| 34 | QUIT XOBOK
|
|---|
| 35 | ;
|
|---|
| 36 | ; -- set up msg type info
|
|---|
| 37 | SETMSG(XOBMSG,XOBXREF,XOBHDLR) ;
|
|---|
| 38 | NEW TYPE,TYPEO
|
|---|
| 39 | KILL XOBHDLR(0)
|
|---|
| 40 | ;
|
|---|
| 41 | ; -- already cached?
|
|---|
| 42 | SET TYPE=$ORDER(XOBHDLR(XOBXREF,XOBMSG,""))
|
|---|
| 43 | IF TYPE QUIT TYPE
|
|---|
| 44 | ;
|
|---|
| 45 | ; -- load req handler
|
|---|
| 46 | SET TYPE=+$ORDER(^XOB(18.05,XOBXREF,XOBMSG,""))
|
|---|
| 47 | IF TYPE DO
|
|---|
| 48 | . SET TYPE0=$GET(^XOB(18.05,TYPE,0))
|
|---|
| 49 | . DO SET(.TYPE,.TYPE0,.XOBHDLR)
|
|---|
| 50 | IF 'TYPE DO
|
|---|
| 51 | . SET XOBHDLR(0)=0
|
|---|
| 52 | . SET XOBHDLR(0,"ERROR")="No message type defined"
|
|---|
| 53 | QUIT TYPE
|
|---|
| 54 | ;
|
|---|
| 55 | SET(TYPE,TYPE0,XOBHDLR) ; -- set nodes
|
|---|
| 56 | NEW IRTN,XOBICBK
|
|---|
| 57 | KILL XOBHDLR(TYPE)
|
|---|
| 58 | SET IRTN=$$IRTN(TYPE0)
|
|---|
| 59 | IF IRTN="" DO GOTO SETQ
|
|---|
| 60 | . SET XOBHDLR(TYPE)=0
|
|---|
| 61 | . IF TYPE0="" SET XOBHDLR(TYPE,"ERROR")="No entry for message type ["_TYPE_"]" QUIT
|
|---|
| 62 | . IF IRTN="" SET XOBHDLR(TYPE,"ERROR")="Invalid interface routine specified ["_$PIECE(TYPE0,U,5)_"]" QUIT
|
|---|
| 63 | ;
|
|---|
| 64 | SET XOBHDLR(TYPE)=1
|
|---|
| 65 | SET XOBHDLR(TYPE,"AUTHENTICATE")=+$PIECE(TYPE0,U,4)
|
|---|
| 66 | SET XOBHDLR(TYPE,"REQHDLR")="DO REQHDLR^"_IRTN_"(.XOBDATA)"
|
|---|
| 67 | SET XOBHDLR(TYPE,"READER")="DO READER^"_IRTN_"(.XOBX,.XOBDATA)"
|
|---|
| 68 | IF $PIECE(TYPE0,U,1)]"" SET XOBHDLR("NAME",$PIECE(TYPE0,U,1),TYPE)=""
|
|---|
| 69 | IF $PIECE(TYPE0,U,2)]"" SET XOBHDLR("MSGTYPE",$PIECE(TYPE0,U,2),TYPE)=""
|
|---|
| 70 | IF $PIECE(TYPE0,U,7)]"" SET XOBHDLR("D",$PIECE(TYPE0,U,7),TYPE)=""
|
|---|
| 71 | ;
|
|---|
| 72 | ; -- set up SAX callbacks
|
|---|
| 73 | SET XOBHDLR(TYPE,"CB","ELEST")="QUIT"
|
|---|
| 74 | SET XOBHDLR(TYPE,"CB","ELEND")="QUIT"
|
|---|
| 75 | SET XOBHDLR(TYPE,"CB","CHR")="QUIT"
|
|---|
| 76 | ;
|
|---|
| 77 | XECUTE "DO CALLBACK^"_IRTN_"(.XOBICBK)"
|
|---|
| 78 | IF $DATA(XOBICBK("STARTELEMENT")) SET XOBHDLR(TYPE,"CB","ELEST")="DO "_XOBICBK("STARTELEMENT")_"(.ELE,.ATR)"
|
|---|
| 79 | IF $DATA(XOBICBK("ENDELEMENT")) SET XOBHDLR(TYPE,"CB","ELEND")="DO "_XOBICBK("ENDELEMENT")_"(.ELE)"
|
|---|
| 80 | IF $DATA(XOBICBK("CHARACTERS")) SET XOBHDLR(TYPE,"CB","CHR")="DO "_XOBICBK("CHARACTERS")_"(.TXT)"
|
|---|
| 81 | SETQ ;
|
|---|
| 82 | QUIT
|
|---|
| 83 | ;
|
|---|
| 84 | ; -- get interface routine and test for existence
|
|---|
| 85 | IRTN(XOBTYPE0) ;
|
|---|
| 86 | NEW X,RTN
|
|---|
| 87 | SET RTN=""
|
|---|
| 88 | SET X=$PIECE(XOBTYPE0,"^",5)
|
|---|
| 89 | IF X]"" DO
|
|---|
| 90 | . XECUTE ^%ZOSF("TEST")
|
|---|
| 91 | . IF $TEST SET RTN=X
|
|---|
| 92 | QUIT RTN
|
|---|
| 93 | ;
|
|---|
