| 1 | ewdu ; JJIH/SMH - Utilities for EWD to VISTA interaction ; 11/18/11 5:39pm
 | 
|---|
| 2 |  ;
 | 
|---|
| 3 | r(sessid) ; Restore Symbol Table
 | 
|---|
| 4 |  d mergeArrayFromSession^%zewdAPI(.DUZ,"DUZ",sessid)
 | 
|---|
| 5 |  d mergeArrayFromSession^%zewdAPI(.IO,"IO",sessid)
 | 
|---|
| 6 |  s U=$$getSessionValue^%zewdAPI("U",sessid)
 | 
|---|
| 7 |  s DILOCKTM=$$getSessionValue^%zewdAPI("DILOCKTM",sessid)
 | 
|---|
| 8 |  s DIQUIET=$$getSessionValue^%zewdAPI("DIQUIET",sessid)
 | 
|---|
| 9 |  s DISYS=$$getSessionValue^%zewdAPI("DISYS",sessid)
 | 
|---|
| 10 |  s DT=$$getSessionValue^%zewdAPI("DT",sessid)
 | 
|---|
| 11 |  s DTIME=$$getSessionValue^%zewdAPI("DTIME",sessid)
 | 
|---|
| 12 |  quit
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 | s(sessid) ; Save to Symbol Table
 | 
|---|
| 15 |  set DIQUIET=1 d DT^DICRW
 | 
|---|
| 16 |  d mergeArrayToSession^%zewdAPI(.DUZ,"DUZ",sessid)
 | 
|---|
| 17 |  d mergeArrayToSession^%zewdAPI(.IO,"IO",sessid)
 | 
|---|
| 18 |  d setSessionValue^%zewdAPI("U","^",sessid)
 | 
|---|
| 19 |  d setSessionValue^%zewdAPI("DILOCKTM",DILOCKTM,sessid)
 | 
|---|
| 20 |  d setSessionValue^%zewdAPI("DIQUIET",DIQUIET,sessid)
 | 
|---|
| 21 |  d setSessionValue^%zewdAPI("DISYS",DISYS,sessid)
 | 
|---|
| 22 |  d setSessionValue^%zewdAPI("DT",DT,sessid)
 | 
|---|
| 23 |  d setSessionValue^%zewdAPI("DTIME",DTIME,sessid)
 | 
|---|
| 24 |  quit
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 |  ; Custom Tag
 | 
|---|
| 27 | SS(nodeOID,attrValues,docOID,technology) ; <vista:session> to get VISTA Session Variables
 | 
|---|
| 28 |  N attr
 | 
|---|
| 29 |  S attr("method")="r^ewdu"
 | 
|---|
| 30 |  S attr("param1")="#ewd_sessid"
 | 
|---|
| 31 |  S attr("type")="procedure"
 | 
|---|
| 32 |  N xOID s xOID=$$addElementToDOM^%zewdDOM("ewd:execute",nodeOID,"",.attr)
 | 
|---|
| 33 |  D removeIntermediateNode^%zewdDOM(nodeOID)
 | 
|---|
| 34 |  quit
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 | NULL ; Open Null Device
 | 
|---|
| 37 |  s %ZIS="0H",IOP="NULL" d ^%ZIS
 | 
|---|
| 38 |  i POP s $ec=",U1,"  ; this crashes everything... intended...
 | 
|---|
| 39 |  q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | setup(sessid) ; Set-up and SSO
 | 
|---|
| 42 |  ; TODO: Set IO("CLNM")
 | 
|---|
| 43 |  i '$data(IO) d NULL                  ; Open Null Device
 | 
|---|
| 44 |  s IO("IP")=$$getServerValue^%zewdAPI("REMOTE_ADDR",sessid)
 | 
|---|
| 45 |  n return
 | 
|---|
| 46 |  d SETUP^XUSRB(.return)               ; Set-up and Try SSO
 | 
|---|
| 47 |  ;0=server name, 1=volume, 2=uci, 3=device, 4=# attempts, 5=skip signon-screen,6=Domain Name, 7=Production (0=no, 1=Yes)
 | 
|---|
| 48 |  i $g(return(5)),DUZ>0 q $$s(sessid)  ; Single Sign-On Successful; need redirect though here.
 | 
|---|
| 49 |  e  d  q ""                           ; Otherwise, get INTRO text
 | 
|---|
| 50 |  . N INTROTXT
 | 
|---|
| 51 |  . D INTRO^XUSRB(.INTROTXT)
 | 
|---|
| 52 |  . d mergeArrayToSession^%zewdAPI(.INTROTXT,"so.introtxt",sessid)
 | 
|---|
| 53 |  . d setSessionValue^%zewdAPI("so.serverName",return(0),sessid)
 | 
|---|
| 54 |  . d setSessionValue^%zewdAPI("so.volume",return(1),sessid)
 | 
|---|
| 55 |  . d setSessionValue^%zewdAPI("so.uci",return(2),sessid)
 | 
|---|
| 56 |  . ; Don't care about device! (return(3))
 | 
|---|
| 57 |  . ; Number of Attempts (return(4))
 | 
|---|
| 58 |  . d setSessionValue^%zewdAPI("so.fqdn",return(6),sessid)
 | 
|---|
| 59 |  . d setSessionValue^%zewdAPI("so.prod",return(7),sessid)
 | 
|---|
| 60 |  . ; 
 | 
|---|
| 61 |  . ; Get the Date in the Symbol Table since $$SITE wants it
 | 
|---|
| 62 |  . s DIQUIET=1 d DT^DICRW
 | 
|---|
| 63 |  . ;
 | 
|---|
| 64 |  . ; Get the site name and format it
 | 
|---|
| 65 |  . n sitename s sitename=$P($$SITE^VASITE(),"^",2)
 | 
|---|
| 66 |  . s sitename=$$TITLE^XLFSTR(sitename)
 | 
|---|
| 67 |  . d setSessionValue^%zewdAPI("so.sitename",sitename,sessid)
 | 
|---|
| 68 |  ; ---
 | 
|---|
| 69 | so(sessid) ; SO from EWD; routes to $$SO
 | 
|---|
| 70 |  ; TODO: Set IO("CLNM")
 | 
|---|
| 71 |  d NULL                             ; IO set-up
 | 
|---|
| 72 |  s IO("IP")=$$getServerValue^%zewdAPI("REMOTE_ADDR",sessid)
 | 
|---|
| 73 |  d SETUP^XUSRB();                   ; This time, just need partition set-up
 | 
|---|
| 74 |  n ac s ac=$$getSessionValue^%zewdAPI("ac",sessid)
 | 
|---|
| 75 |  n vc s vc=$$getSessionValue^%zewdAPI("vc",sessid)
 | 
|---|
| 76 |  n result s result=$$SO(ac,vc)
 | 
|---|
| 77 |  ;
 | 
|---|
| 78 |  ; Change Verify Code Logic Ahead... Damn Complex!
 | 
|---|
| 79 |  i $l(result),result="CVC" d  q ""  ; User must change Verify Code
 | 
|---|
| 80 |  . S DUZ=$$STATE^XWBSEC("XUS DUZ")  ; VISTA kills off DUZ if vc needs changing.
 | 
|---|
| 81 |  .                                  ; That's fine when it can get it back. But we are not a stateful process.
 | 
|---|
| 82 |  .                                  ; By the time the second request is made, XUS DUZ is gone gone gone.
 | 
|---|
| 83 |  . d s(sessid)                      ; Save symbol table for next page (including DUZ)
 | 
|---|
| 84 |  . d setRedirect^%zewdAPI("cvc",sessid) ; Next page is cvc.
 | 
|---|
| 85 |  . d setSessionValue^%zewdAPI("cvcForced",1,sessid) ; Need to know that the user is toast!
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  i $l(result) q result  ; General Error Message - User can't log-in
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 |  e  d  q ""  ; Everything Okay
 | 
|---|
| 90 |  . d s(sessid)
 | 
|---|
| 91 |  . i $$isCheckboxOn^%zewdAPI("cvc","cvc",sessid) d setRedirect^%zewdAPI("cvc",sessid)
 | 
|---|
| 92 |  ;
 | 
|---|
| 93 | SO(ac,vc) ; Sign-on to VISTA, AV way
 | 
|---|
| 94 |  ; TODO: Handle the rest of the return values
 | 
|---|
| 95 |  N return
 | 
|---|
| 96 |  ; if ac contains ;, then it contains the verify code
 | 
|---|
| 97 |  ; else, send ac;vc
 | 
|---|
| 98 |  if ac[";" d VALIDAV^XUSRB(.return,$$ENCRYP^XUSRB1(ac))
 | 
|---|
| 99 |  else  d VALIDAV^XUSRB(.return,$$ENCRYP^XUSRB1(ac_";"_vc))
 | 
|---|
| 100 |  i return(0)>0,'return(2) q "" ; Sign on successful!
 | 
|---|
| 101 |  i return(0)=0,return(2) q "CVC"  ; Verify Code must be changed NOW!
 | 
|---|
| 102 |  i $l(return(3)) q return(3)  ; Error Message returned whole
 | 
|---|
| 103 |  ; Note: division selection not implemented here
 | 
|---|
| 104 |  quit ""
 | 
|---|
| 105 |  ; ---
 | 
|---|
| 106 | sss(id) ; Test
 | 
|---|
| 107 |  d setRedirect^%zewdAPI("index",id,"bb")
 | 
|---|
| 108 |  q ""
 | 
|---|
| 109 | whoami(sessid) ; Who Am I? PrePage Script
 | 
|---|
| 110 |  d r(sessid)
 | 
|---|
| 111 |  n Name s Name=$$GET1^DIQ(200,DUZ,.01) ; User Name
 | 
|---|
| 112 |  d setSessionValue^%zewdAPI("Name",Name,sessid)
 | 
|---|
| 113 |  q ""
 | 
|---|
| 114 | cvc(sessid) ; Change Verify Code
 | 
|---|
| 115 |  ; get stored session values for DUZ, IO, and U
 | 
|---|
| 116 |  d r(sessid) ; Restore the Symbol Table
 | 
|---|
| 117 |  n VC1,VC2,VC3
 | 
|---|
| 118 |  s VC1=$$getPasswordValue^%zewdAPI("vc1",sessid)
 | 
|---|
| 119 |  s VC2=$$getPasswordValue^%zewdAPI("vc2",sessid)
 | 
|---|
| 120 |  s VC3=$$getPasswordValue^%zewdAPI("vc3",sessid)
 | 
|---|
| 121 |  ; Uppercase them -- otherwise CVC will fail.
 | 
|---|
| 122 |  s VC1=$$UP^XLFSTR(VC1)
 | 
|---|
| 123 |  s VC2=$$UP^XLFSTR(VC2)
 | 
|---|
| 124 |  s VC3=$$UP^XLFSTR(VC3)
 | 
|---|
| 125 |  ; Roman Cipher them vista-wise
 | 
|---|
| 126 |  n eVC1,eVC2,eVC3
 | 
|---|
| 127 |  s eVC1=$$ENCRYP^XUSRB1(VC1)
 | 
|---|
| 128 |  s eVC2=$$ENCRYP^XUSRB1(VC2)
 | 
|---|
| 129 |  s eVC3=$$ENCRYP^XUSRB1(VC3)
 | 
|---|
| 130 |  ; Set-up Call
 | 
|---|
| 131 |  n vcString s vcString=eVC1_U_eVC2_U_eVC3
 | 
|---|
| 132 |  n ret
 | 
|---|
| 133 |  d CVC^XUSRB(.ret,vcString)
 | 
|---|
| 134 |  i ret(0)=0 q ""  ; Success
 | 
|---|
| 135 |  i ret(0)>0 q ret(1)  ; Failure
 | 
|---|
| 136 |  ;;
 | 
|---|
| 137 |  ;;return(0)=0
 | 
|---|
| 138 |  ;;return(1)=0
 | 
|---|
| 139 |  ;;return(2)=1
 | 
|---|
| 140 |  ;;return(3)="VERIFY CODE must be changed before continued use."
 | 
|---|
| 141 |  ;;return(4)=0
 | 
|---|
| 142 |  ;;return(5)=0
 | 
|---|
| 143 |  ;;return(6)=""
 | 
|---|
| 144 |  ;;return(7)="Good evening DOCTOR,TEN"
 | 
|---|
| 145 |  ;;return(8)="     You last signed on today at 22:19"
 | 
|---|
| 146 | listEWDApps(sessid)  ; Lists all available EWD Applicaitons, not including ewdMgr. Intended to be an imitation of a menu.
 | 
|---|
| 147 |  n apps  ; Will hold our applications
 | 
|---|
| 148 |  do
 | 
|---|
| 149 |  . n ewdpath s ewdpath=^zewd("config","applicationRootPath")
 | 
|---|
| 150 |  . o "lsApps":(shell="/bin/bash":command="ls -1 "_ewdpath:READONLY)::"PIPE"
 | 
|---|
| 151 |  . u "lsApps"
 | 
|---|
| 152 |  . n line
 | 
|---|
| 153 |  . n counter s counter=1
 | 
|---|
| 154 |  . for  read line quit:$zeof  do
 | 
|---|
| 155 |  . . i line="ewdMgr" quit  ; Don't include ewdMgr
 | 
|---|
| 156 |  . . s apps(counter)=line
 | 
|---|
| 157 |  . . s counter=counter+1
 | 
|---|
| 158 |  . c "lsApps"
 | 
|---|
| 159 |  . zwrite:$g(debug) apps
 | 
|---|
| 160 |  . d mergeArrayToSession^%zewdAPI(.apps,"installedapps",sessid)
 | 
|---|
| 161 |  ;
 | 
|---|
| 162 |  ; Old code: uses JSON
 | 
|---|
| 163 |  ; n appsjson s appsjson=$$arrayToJSON^%zewdJSON("apps")
 | 
|---|
| 164 |  ; zwrite:$g(debug) appsjson
 | 
|---|
| 165 |  ; d setSessionValue^%zewdAPI("appsjson",appsjson,sessid)
 | 
|---|
| 166 |  ; 
 | 
|---|
| 167 |  q ""
 | 
|---|
| 168 | redir(sessid)
 | 
|---|
| 169 |  n redirapp s redirapp=$$getRequestValue^%zewdAPI("nextapp",sessid)
 | 
|---|
| 170 |  d setRedirect^%zewdAPI("index",sessid,redirapp)
 | 
|---|
| 171 |  q ""
 | 
|---|
| 172 |  ;
 | 
|---|