source: WorldVistAEHR/trunk/r/VISTALINK_SECURITY-XOBS/XOBSCAV2.m@ 949

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

initial load of WorldVistAEHR
File size: 8.7 KB
Line 
1XOBSCAV2 ;; kec/oak - VistaLink Access/Verify Security ; 12/09/2002 17:00
2 ;;1.5;VistALink Security;;Sep 09, 2005
3 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
4 ;;
5 QUIT
6 ;
7 ; --------------------------------------------------------------------
8 ; Access/Verify Security: Security Message Request Handler
9 ; (AV.GetUserDemographics req/resp pairs; XML parser callbacks)
10 ; --------------------------------------------------------------------
11 ;
12 ;==== AV.GetUserDemographics.Request message processing ====
13SENDDEM ; respond to user demographics request
14 IF '$$LOGGEDON^XOBSCAV() DO SENDDEM0("User not logged on.")
15 DO SENDDEM1
16 QUIT
17SENDDEM1 ; success
18 NEW XOBMSG,XOBI,XOBNC,XOBNC1,XOBDIV,XOBRET,XOBERR,XOBTXT
19 ; get ptr to Name Components file
20 DO GETS^DIQ(200,DUZ_",","10.1","I","XOBNC","XOBERR")
21 IF $DATA(XOBERR) DO QUIT
22 .SET XOBI=0,XOBTXT="FileMan Error: "
23 .FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
24 .DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
25 SET XOBNC=XOBNC(200,DUZ_",",10.1,"I")
26 ; get name components -- read access to file 20: DBIA# 3041
27 DO GETS^DIQ(20,XOBNC_",","1:6","","XOBNC1","XOBERR")
28 IF $DATA(XOBERR) DO QUIT
29 .SET XOBI=0,XOBTXT="FileMan Error: "
30 .FOR SET XOBI=$ORDER(XOBERR("DIERR",XOBI)) QUIT:'+XOBI SET XOBTXT=XOBTXT_XOBERR("DIERR",XOBI)_" "_XOBERR("DIERR",XOBI,"TEXT",1)
31 .DO ERROR^XOBSCAV(.XOBR,$PIECE($TEXT(FSERVER^XOBSCAV),";;",2),"Demographics failure",183006,$$CHARCHK^XOBVLIB($$EZBLD^DIALOG(183006,.XOBTXT)))
32 ; get more userinfo from Kernel
33 DO USERINFO^XUSRB2(.XOBRET) ; use of USERINFO^XUSRB2: DBIA #4055
34 ; strip any illegal xml chars from data
35 FOR XOBI=1:1:7 SET XOBRET(XOBI)=$$CHARCHK^XOBVLIB(XOBRET(XOBI))
36 FOR XOBI=1:1:6 SET XOBNC1(20,XOBNC_",",XOBI)=$$CHARCHK^XOBVLIB(XOBNC1(20,XOBNC_",",XOBI))
37 ; format return message
38 SET XOBMSG(1)="<NameInfo prefix='"_XOBNC1(20,XOBNC_",",4)_"' givenFirst='"_XOBNC1(20,XOBNC_",",2)_"' middle='"_XOBNC1(20,XOBNC_",",3)
39 SET XOBMSG(1)=XOBMSG(1)_"' familyLast='"_XOBNC1(20,XOBNC_",",1)_"' suffix='"_XOBNC1(20,XOBNC_",",5)
40 SET XOBMSG(1)=XOBMSG(1)_"' degree='"_XOBNC1(20,XOBNC_",",6)_"' newPerson01Name='"_XOBRET(1)_"' standardConcatenated='"_XOBRET(2)_"' />"
41 SET XOBMSG(2)="<UserInfo duz='"_DUZ_"' title='"_$$CHARCHK^XOBVLIB(XOBRET(4))_"' serviceSection='"_$$CHARCHK^XOBVLIB(XOBRET(5))_"' language='"_$$CHARCHK^XOBVLIB(XOBRET(6))_"' timeout='"_$$CHARCHK^XOBVLIB(XOBRET(7))
42 SET XOBMSG(2)=XOBMSG(2)_"' vpid='"_$$CHARCHK^XOBVLIB($G(XOBRET(8)))_"' />"
43 SET XOBMSG(3)="<Division ien='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U))_"' divName='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,2))_"' divNumber='"_$$CHARCHK^XOBVLIB($PIECE(XOBRET(3),U,3))_"' />"
44 SET XOBMSG(4)="<SiteInfo domainName='"_$$KSP^XUPARAM("WHERE")_"'/>"
45 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHUSERD^XOBSCAV),";;",2))
46 QUIT
47SENDDEM0(XOBTEXT) ; failure
48 NEW XOBMSG
49 SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB(XOBTEXT)_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
50 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUSERD^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
51 QUIT
52 ;
53 ; ==== SAX Parser Callbacks ====
54 ;
55ELEST(ELE,ATR) ; -- element start event handler
56 ;
57 IF ELE="VistaLink" DO QUIT
58 . SET XOBDATA("MODE")=$GET(ATR("mode"),"singleton")
59 . SET XOBDATA("XOB SECAV","SECURITYTYPE")=$GET(ATR("messageType"),"unknown")
60 ;
61 IF ELE="SecurityInfo" DO QUIT
62 . SET XOBDATA("XOB SECAV","SECURITYVERSION")=$GET(ATR("version"),"unknown")
63 ;
64 IF ELE="Request" DO QUIT
65 . SET XOBDATA("XOB SECAV","SECURITYACTION")=$GET(ATR("type"),"unknown")
66 ;
67 IF XOBDATA("XOB SECAV","SECURITYTYPE")'=$$MSGTYP^XOBSCAV("request") DO QUIT
68 .;if not a security request, shouldn't be here
69 .;
70 IF '$DATA(XOBDATA("XOB SECAV","SECURITYACTION")) DO QUIT
71 .;if haven't processed the "action" yet, shouldn't be here
72 ;
73 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SetupAndIntroText" DO QUIT
74 . IF ELE="productionInfo" DO
75 . . SET XOBDATA("CLIENTISPRODUCTION")=$GET(ATR("clientIsProduction"))
76 . . SET XOBDATA("CLIENTPRIMARYSTATION")=$GET(ATR("clientPrimaryStation"))
77 ;
78 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.GetUserDemographics" DO QUIT
79 .; nothing needed
80 .;
81 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logon" DO QUIT
82 .IF ELE="avCodes" SET XOBAVCOD=""
83 .SET XOBDATA("XOB SECAV","REQUESTCVC")=$GET(ATR("requestCvc"))
84 ;
85 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.Logout" DO QUIT
86 .; nothing needed
87 ;
88 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.SelectDivision" DO QUIT
89 .IF ELE="Division" SET XOBDATA("XOB SECAV","SELECTEDDIVISION")=$GET(ATR("ien"))
90 ;
91 IF XOBDATA("XOB SECAV","SECURITYACTION")="AV.UpdateVC" DO QUIT
92 .IF ELE="oldVc" SET XOBVCOLD="" QUIT
93 .IF ELE="newVc" SET XOBVCNEW="" QUIT
94 .IF ELE="confirmedVc" SET XOBVCCHK="" QUIT
95 ;
96 ;If got here -- an unknown type, ignore.
97 ;
98 QUIT
99 ;
100ELEND(ELE) ; -- element end event handler
101 ;
102 IF ELE="VistaLink" KILL XOBAVCOD,XOBVCOLD,XOBVCNEW,XOBVCCHK QUIT
103 IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.Logon",ELE="avCodes" DO QUIT
104 .SET XOBDATA("XOB SECAV","AVCODE")=XOBAVCOD KILL XOBAVCOD
105 IF $GET(XOBDATA("XOB SECAV","SECURITYACTION"))="AV.UpdateVC" DO QUIT
106 .IF ELE="oldVc" SET XOBDATA("XOB SECAV","OLDVC")=XOBVCOLD KILL XOBVCOLD QUIT
107 .IF ELE="newVc" SET XOBDATA("XOB SECAV","NEWVC")=XOBVCNEW KILL XOBVCNEW QUIT
108 .IF ELE="confirmedVc" SET XOBDATA("XOB SECAV","NEWVCCHECK")=XOBVCCHK KILL XOBVCCHK QUIT
109 .;shouldn't get here.
110 QUIT
111 ;
112CHR(TEXT) ; -- character value event handler <tag>TEXT</tag)
113 ; -- need to concatenate because MXML parses on ENTITY characters (<>& etc.) and
114 ; callback gets hit multiple times even though the tag text value is just one piece of data.
115 ; (Yes, this seems kludgie!)
116 IF $DATA(XOBAVCOD) SET XOBAVCOD=XOBAVCOD_TEXT QUIT
117 IF $DATA(XOBVCOLD) SET XOBVCOLD=XOBVCOLD_TEXT QUIT
118 IF $DATA(XOBVCNEW) SET XOBVCNEW=XOBVCNEW_TEXT QUIT
119 IF $DATA(XOBVCCHK) SET XOBVCCHK=XOBVCCHK_TEXT QUIT
120 QUIT
121 ;==== AV.UpdateVC.Request message processing ====
122SENDNVC ; respond to "change verify code" request. Use of CVC^XUSRB per DBIA #4054
123 NEW XOBRET,XOBRETDV,XOBSDUZ
124 SET XOBSDUZ=DUZ ; save DUZ in case of failure - we need to restore
125 DO CVC^XUSRB(.XOBRET,XOBDATA("XOB SECAV","OLDVC")_U_XOBDATA("XOB SECAV","NEWVC")_U_XOBDATA("XOB SECAV","NEWVCCHECK"))
126 IF +$GET(DUZ) DO QUIT ; success changing verify code
127 .; check the divisions now
128 .DO DIVGET^XUSRB2(.XOBRETDV,DUZ) ; use of DIVGET^XUSRB2: DBIA #4055
129 .IF '+XOBRETDV(0) DO SENDNVC1 QUIT
130 .; otherwise this is a multidivisional user
131 .DO SENDNVCD(.XOBRETDV)
132 ; cvc failed
133 SET DUZ=XOBSDUZ ; restore DUZ
134 DO SENDNVC0 ; failure
135 QUIT
136SENDNVC1 ; send verify code update success
137 ;update the vc/finish the logon
138 NEW XOBMSG
139 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$SUCCESS^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
140 QUIT
141SENDNVC0 ; send verify code update error
142 ;update the vc/finish the logon
143 NEW XOBMSG,XOBI
144 SET XOBMSG(1)="<"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"_$$CHARCHK^XOBVLIB($GET(XOBRET(1)))_"</"_$PIECE($TEXT(MSGTAG^XOBSCAV),";;",2)_">"
145 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$FAILURE^XOBSCAV(),$PIECE($TEXT(SCHSIMPL^XOBSCAV),";;",2))
146 QUIT
147SENDNVCD(XOBDIVS) ; send verify code partial success, need divisions
148 ;XOBDIVS is in format of output from DIVGET^XUSRB2
149 NEW XOBMSG,XOBI,XOBLINE
150 SET XOBLINE=$$ADDDIVS^XOBSCAV(.XOBDIVS,.XOBMSG)
151 DO SENDSEC^XOBSCAV(.XOBR,$PIECE($TEXT(RESTYPE^XOBSCAV),";;",2),$PIECE($TEXT(MSGUPDVC^XOBSCAV),";;",2),.XOBMSG,$$PARTIAL^XOBSCAV(),$PIECE($TEXT(SCHPARTS^XOBSCAV),";;",2))
152 QUIT
153 ;
154 ;==== utility functions ====
155 ;
156GETINTRO(XOBSREF,XOBSCNTR) ;
157 ; XOBSREF: variable in which to store intro text (at one level descendant)
158 ; XOBSCNT: integer subscript counter value at which to start storing text
159 ; returns: XOBSREF containing <IntroText> element text with intro text lines in CDATA section
160 ; XOBSCNT incremented to last subscript at which text was stored (if passed as dot-arg)
161 ;
162 NEW XOBCCMSK,XOBI,XOBITINF,XOBTMP1
163 ; get intro text
164 DO INTRO^XUSRB(.XOBITINF) ; use of INTRO^XUSRB: DBIA #4054
165 ; set up control character mask
166 SET XOBCCMSK="" FOR XOBI=0:1:8,11,12,14:1:31 SET XOBCCMSK=XOBCCMSK_$CHAR(XOBI)
167 ; populate/format return value
168 SET @XOBSREF@(XOBSCNTR)="<IntroText><![CDATA["
169 SET XOBTMP1=-1 FOR SET XOBTMP1=$ORDER(XOBITINF(XOBTMP1)) QUIT:XOBTMP1']"" DO
170 .SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)=$TRANSLATE(XOBITINF(XOBTMP1),XOBCCMSK,"")_"<BR>"
171 SET XOBSCNTR=XOBSCNTR+1,@XOBSREF@(XOBSCNTR)="]]></IntroText>"
172 QUIT
173 ;
Note: See TracBrowser for help on using the repository browser.