source: FOIAVistA/trunk/r/VISTALINK-XOBV/XOBVRH.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1XOBVRH ;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
12MSGNAME(XOBMSG,XOBHDLR) ; -- set up msg type info
13 QUIT $$SETMSG(XOBMSG,"NAME",.XOBHDLR)
14 ;
15 ; -- set up msg type info using message type
16MSGTYPE(XOBMSG,XOBHDLR) ; -- set up msg type info
17 QUIT $$SETMSG(XOBMSG,"MSGTYPE",.XOBHDLR)
18 ;
19 ; -- set up msg type info using proprietary string
20MSGSINK(XOBMSG,XOBHDLR) ; -- set up msg type info
21 QUIT $$SETMSG(XOBMSG,"D",.XOBHDLR)
22 ;
23CACHE(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
37SETMSG(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 ;
55SET(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)"
81SETQ ;
82 QUIT
83 ;
84 ; -- get interface routine and test for existence
85IRTN(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 ;
Note: See TracBrowser for help on using the repository browser.