| [1305] | 1 | ewdu ; JJIH/SMH - Utilities for EWD to VISTA interaction ; 11/18/11 5:39pm
|
|---|
| [1284] | 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 | quit
|
|---|
| 8 | ;
|
|---|
| 9 | s(sessid) ; Save to Symbol Table
|
|---|
| 10 | d mergeArrayToSession^%zewdAPI(.DUZ,"DUZ",sessid)
|
|---|
| 11 | d mergeArrayToSession^%zewdAPI(.IO,"IO",sessid)
|
|---|
| 12 | d setSessionValue^%zewdAPI("U","^",sessid)
|
|---|
| 13 | quit
|
|---|
| 14 | ;
|
|---|
| 15 | NULL ; Open Null Device
|
|---|
| 16 | s %ZIS="0H",IOP="NULL" d ^%ZIS
|
|---|
| 17 | i POP s $ec=",U1," ; this crashes everything... intended...
|
|---|
| 18 | q
|
|---|
| 19 | ;
|
|---|
| 20 | SETUP(sessid) ; Set-up and SSO
|
|---|
| 21 | ; TODO: Set IO("CLNM")
|
|---|
| 22 | i '$data(IO) d NULL ; Open Null Device
|
|---|
| 23 | s IO("IP")=$$getServerValue^%zewdAPI("REMOTE_ADDR",sessid)
|
|---|
| 24 | n return
|
|---|
| 25 | d SETUP^XUSRB(.return) ; Set-up and Try SSO
|
|---|
| 26 | i $g(return(5)),DUZ>0 q $$s(sessid) ; Single Sign-On Successful!
|
|---|
| 27 | e d q "" ; Otherwise, get INTRO text
|
|---|
| 28 | . N RET
|
|---|
| 29 | . D INTRO^XUSRB(.RET)
|
|---|
| 30 | . d mergeArrayToSession^%zewdAPI(.RET,"introtxt",sessid)
|
|---|
| 31 | ; ---
|
|---|
| 32 | so(sessid) ; SO from EWD; routes to $$SO
|
|---|
| 33 | ; TODO: Set IO("CLNM")
|
|---|
| 34 | d NULL ; IO set-up
|
|---|
| 35 | s IO("IP")=$$getServerValue^%zewdAPI("REMOTE_ADDR",sessid)
|
|---|
| 36 | d SETUP^XUSRB(); ; This time, just need partition set-up
|
|---|
| 37 | n ac s ac=$$getSessionValue^%zewdAPI("ac",sessid)
|
|---|
| 38 | n vc s vc=$$getSessionValue^%zewdAPI("vc",sessid)
|
|---|
| 39 | n result s result=$$SO(ac,vc)
|
|---|
| 40 | ;
|
|---|
| 41 | ; Change Verify Code Logic Ahead... Damn Complex!
|
|---|
| 42 | i $l(result),result="CVC" d q "" ; User must change Verify Code
|
|---|
| 43 | . S DUZ=$$STATE^XWBSEC("XUS DUZ") ; VISTA kills off DUZ if vc needs changing.
|
|---|
| 44 | . ; That's fine when it can get it back. But we are not a stateful process.
|
|---|
| 45 | . ; By the time the second request is made, XUS DUZ is gone gone gone.
|
|---|
| 46 | . d s(sessid) ; Save symbol table for next page (including DUZ)
|
|---|
| 47 | . d setRedirect^%zewdAPI("cvc",sessid) ; Next page is cvc.
|
|---|
| 48 | . d setSessionValue^%zewdAPI("cvcForced",1,sessid) ; Need to know that the user is toast!
|
|---|
| 49 | ;
|
|---|
| 50 | i $l(result) q result ; General Error Message - User can't log-in
|
|---|
| 51 | ;
|
|---|
| 52 | e d q "" ; Everything Okay
|
|---|
| 53 | . d s(sessid)
|
|---|
| 54 | . i $$isCheckboxOn^%zewdAPI("cvc","cvc",sessid) d setRedirect^%zewdAPI("cvc",sessid)
|
|---|
| 55 | ;
|
|---|
| 56 | SO(ac,vc) ; Sign-on to VISTA, AV way
|
|---|
| 57 | ; TODO: Handle the rest of the return values
|
|---|
| 58 | N return
|
|---|
| 59 | D VALIDAV^XUSRB(.return,$$ENCRYP^XUSRB1(ac_";"_vc))
|
|---|
| 60 | i return(0)>0,'return(2) q "" ; Sign on successful!
|
|---|
| 61 | i return(0)=0,return(2) q "CVC" ; Verify Code must be changed NOW!
|
|---|
| 62 | i $l(return(3)) q return(3) ; Error Message returned whole
|
|---|
| 63 | ; Note: division selection not implemented here
|
|---|
| 64 | quit ""
|
|---|
| 65 | ; ---
|
|---|
| 66 | sss(id) ; Test
|
|---|
| 67 | d setRedirect^%zewdAPI("index",id,"bb")
|
|---|
| 68 | q ""
|
|---|
| 69 | whoami(sessid) ; Who Am I? PrePage Script
|
|---|
| 70 | d r(sessid)
|
|---|
| 71 | n Name s Name=$$GET1^DIQ(200,DUZ,.01) ; User Name
|
|---|
| 72 | d setSessionValue^%zewdAPI("Name",Name,sessid)
|
|---|
| 73 | q ""
|
|---|
| 74 | cvc(sessid) ; Change Verify Code
|
|---|
| 75 | ; get stored session values for DUZ, IO, and U
|
|---|
| 76 | d r(sessid) ; Restore the Symbol Table
|
|---|
| 77 | n VC1,VC2,VC3
|
|---|
| 78 | s VC1=$$getPasswordValue^%zewdAPI("vc1",sessid)
|
|---|
| 79 | s VC2=$$getPasswordValue^%zewdAPI("vc2",sessid)
|
|---|
| 80 | s VC3=$$getPasswordValue^%zewdAPI("vc3",sessid)
|
|---|
| 81 | ; Uppercase them -- otherwise CVC will fail.
|
|---|
| 82 | s VC1=$$UP^XLFSTR(VC1)
|
|---|
| 83 | s VC2=$$UP^XLFSTR(VC2)
|
|---|
| 84 | s VC3=$$UP^XLFSTR(VC3)
|
|---|
| 85 | ; Roman Cipher them vista-wise
|
|---|
| 86 | n eVC1,eVC2,eVC3
|
|---|
| 87 | s eVC1=$$ENCRYP^XUSRB1(VC1)
|
|---|
| 88 | s eVC2=$$ENCRYP^XUSRB1(VC2)
|
|---|
| 89 | s eVC3=$$ENCRYP^XUSRB1(VC3)
|
|---|
| 90 | ; Set-up Call
|
|---|
| 91 | n vcString s vcString=eVC1_U_eVC2_U_eVC3
|
|---|
| 92 | n ret
|
|---|
| 93 | d CVC^XUSRB(.ret,vcString)
|
|---|
| 94 | i ret(0)=0 q "" ; Success
|
|---|
| 95 | i ret(0)>0 q ret(1) ; Failure
|
|---|
| [1285] | 96 | ;;
|
|---|
| 97 | ;;return(0)=0
|
|---|
| 98 | ;;return(1)=0
|
|---|
| 99 | ;;return(2)=1
|
|---|
| 100 | ;;return(3)="VERIFY CODE must be changed before continued use."
|
|---|
| 101 | ;;return(4)=0
|
|---|
| 102 | ;;return(5)=0
|
|---|
| 103 | ;;return(6)=""
|
|---|
| 104 | ;;return(7)="Good evening DOCTOR,TEN"
|
|---|
| 105 | ;;return(8)=" You last signed on today at 22:19"
|
|---|
| 106 | listEWDApps(sessid) ; Lists all available EWD Applicaitons, not including ewdMgr. Intended to be an imitation of a menu.
|
|---|
| 107 | n apps ; Will hold our applications
|
|---|
| 108 | do
|
|---|
| 109 | . n ewdpath s ewdpath=^zewd("config","applicationRootPath")
|
|---|
| 110 | . o "lsApps":(shell="/bin/bash":command="ls -1 "_ewdpath:READONLY)::"PIPE"
|
|---|
| 111 | . u "lsApps"
|
|---|
| 112 | . n line
|
|---|
| 113 | . n counter s counter=1
|
|---|
| 114 | . for read line quit:$zeof do
|
|---|
| 115 | . . i line="ewdMgr" quit ; Don't include ewdMgr
|
|---|
| 116 | . . s apps(counter)=line
|
|---|
| 117 | . . s counter=counter+1
|
|---|
| 118 | . c "lsApps"
|
|---|
| 119 | . zwrite:$g(debug) apps
|
|---|
| [1305] | 120 | . d mergeArrayToSession^%zewdAPI(.apps,"installedapps",sessid)
|
|---|
| [1285] | 121 | ;
|
|---|
| [1305] | 122 | ; Old code: uses JSON
|
|---|
| 123 | ; n appsjson s appsjson=$$arrayToJSON^%zewdJSON("apps")
|
|---|
| 124 | ; zwrite:$g(debug) appsjson
|
|---|
| 125 | ; d setSessionValue^%zewdAPI("appsjson",appsjson,sessid)
|
|---|
| 126 | ;
|
|---|
| [1285] | 127 | q ""
|
|---|
| [1305] | 128 | redir(sessid)
|
|---|
| 129 | n redirapp s redirapp=$$getRequestValue^%zewdAPI("nextapp",sessid)
|
|---|
| 130 | d setRedirect^%zewdAPI("index",sessid,redirapp)
|
|---|
| 131 | q ""
|
|---|
| 132 | ;
|
|---|
| [1307] | 133 |
|
|---|
| 134 | FILES(sessid) ; Get File of Files
|
|---|
| 135 | d clearList^%zewdAPI("file",sessid) ; Clean
|
|---|
| 136 | N FILE S FILE="" ; Looper that is also the File Name
|
|---|
| 137 | FOR S FILE=$O(^DIC("B",FILE)) QUIT:FILE="" DO ; ditto
|
|---|
| 138 | . N IEN S IEN=$O(^(FILE,"")) ; IEN from 2nd subscript in B index
|
|---|
| 139 | . d appendToList^%zewdAPI("file",FILE,IEN,sessid) ; Add to session
|
|---|
| 140 | Q ""
|
|---|
| 141 | ENTRY(sessid) ; Get Entries in a specific file
|
|---|
| 142 | d clearList^%zewdAPI("entry",sessid) ; Clean
|
|---|
| 143 | n file s file=$$getSessionValue^%zewdAPI("file",sessid) ; Get select file from combo box
|
|---|
| 144 | n glo s glo=^DIC(file,0,"GL") ; Get File Global
|
|---|
| 145 | s glo=$$CREF^DILF(glo) ; Get the closed root reference
|
|---|
| 146 | N ENTRY S ENTRY="" ; Looper that is also the Entry
|
|---|
| 147 | FOR S ENTRY=$O(@glo@("B",ENTRY)) QUIT:ENTRY="" DO ; ditto
|
|---|
| 148 | . N IEN S IEN=$O(^(ENTRY,"")) ; IEN
|
|---|
| 149 | . d appendToList^%zewdAPI("entry",ENTRY,IEN,sessid) ; Add to session
|
|---|
| 150 | Q ""
|
|---|
| [1310] | 151 | CAPOPTS(sessid) ; Nothing much
|
|---|
| 152 | K ^SAMOPTS
|
|---|
| 153 | ZSHOW "V":^SAMOPTS
|
|---|
| 154 | Q ""
|
|---|
| [1305] | 155 | INQ(sessid) ; DIINQUIRE Application Pre-Page Script
|
|---|
| [1307] | 156 | ;
|
|---|
| 157 | ; First, get the options
|
|---|
| [1305] | 158 | n outopt ; Output Options checkbox values
|
|---|
| 159 | d getCheckboxValues^%zewdAPI("outopt",.outopt,sessid)
|
|---|
| 160 | n capopts s capopts="" ; Caption Options to get from checkbox values
|
|---|
| 161 | n i s i=""
|
|---|
| 162 | for set i=$order(outopt(i)) q:i="" s capopts=capopts_i
|
|---|
| [1307] | 163 | ;
|
|---|
| 164 | ; Get File and Entry
|
|---|
| 165 | n file s file=$$getSessionValue^%zewdAPI("file",sessid)
|
|---|
| [1310] | 166 | n entry s entry=$$getRequestValue^%zewdAPI("entry",sessid)
|
|---|
| [1307] | 167 | ;
|
|---|
| 168 | ; dbug dbug
|
|---|
| 169 | k ^ZZSAM
|
|---|
| [1310] | 170 | ZSHOW "V":^ZZSAM
|
|---|
| [1307] | 171 | ;
|
|---|
| 172 | ; Now actual VISTA work--write out the output to a file
|
|---|
| [1305] | 173 | S IOP="HFS" D ^%ZIS ; Open HFS Device
|
|---|
| 174 | U IO ; USE HFS Device
|
|---|
| [1307] | 175 | ; D CAPTION^DIQ(file,entry,capopts) ; Write Out Report
|
|---|
| 176 | D CAPTION^DIQ(file,1,"ARC") ; Temp until Russian Doll is fixed :-(
|
|---|
| [1305] | 177 | D ^%ZISC ; Close Device
|
|---|
| [1307] | 178 | ; done
|
|---|
| [1305] | 179 | ;
|
|---|
| 180 | ; This code doesn't work, and my debugger couldn't go through it.
|
|---|
| 181 | ; something is wrong--and I have an old version of GT.M--why is this happening?
|
|---|
| 182 | ; N PATH S PATH=$$PATH^MXMLPRSE(IO("CLOSE"))
|
|---|
| 183 | ; N FILE S FILE=$P(IO("CLOSE"),PATH,2)
|
|---|
| 184 | ; N RESULT S RESULT=$$FTG^%ZISH(PATH,FILE,$NAME(^TMP("EWDU",$J)),3) ; Doesn't work!!!
|
|---|
| 185 | ;
|
|---|
| 186 | ; ------------------> Read the File Back
|
|---|
| 187 | OPEN IO("CLOSE"):(READONLY:rewind) ; Open Again for reading
|
|---|
| 188 | USE IO("CLOSE") ; Use
|
|---|
| 189 | N CNT S CNT=1 ; Counter
|
|---|
| 190 | KILL ^TMP("EWDU",$J) ; Kill TMP Global
|
|---|
| 191 | FOR DO Q:$ZEOF ; Read the file
|
|---|
| 192 | . N % R %
|
|---|
| 193 | . S ^TMP("EWDU",$J,CNT)=%
|
|---|
| 194 | . S CNT=CNT+1
|
|---|
| 195 | C IO("CLOSE"):(delete) ; Close and delete
|
|---|
| 196 | ; <------------------ Close the File
|
|---|
| 197 | ;
|
|---|
| 198 | ; Move to EWD Session
|
|---|
| 199 | d clearSessionArray^%zewdAPI("DIINQUIRE",sessid)
|
|---|
| 200 | d mergeGlobalToSession^%zewdAPI($NAME(^TMP("EWDU",$J)),"DIINQUIRE",sessid)
|
|---|
| 201 | QUIT ""
|
|---|
