Produced by Araxis Merge on 2/17/2017 4:27:36 PM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | VSA P2.5 v3.0.12.zip\src.zip\vsa_vistajs_source_v3.0\vsa-mcode\Routines | XSAPXDV2.int.xml | Mon Jan 16 21:20:00 2017 UTC |
| 2 | VSA P2.5 v3.0.12.zip\src.zip\vsa_vistajs_source_v3.0\vsa-mcode\Routines | XSAPXDV2.int.xml | Fri Feb 17 21:28:43 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 7 | 720 |
| Changed | 6 | 14 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | <?xml | |
| 2 | version="1 .0" | |
| 3 | encoding=" UTF-8" | |
| 4 | ?> | |
| 5 | <Export | |
| 6 | generator= "Cache" | |
| 7 | version="2 5" | |
| 8 | > | |
| 9 | <Routine | |
| 10 | name="XSAP XDV2" | |
| 11 | type="INT" | |
| 12 | languagemo de="0" | |
| 13 | > | |
| 14 | <![CDATA[ | |
| 15 | XSAPXDV2 ; DAL/BNT - VistA Serv ices Assem bler DEV F unctions;1 /27/2016 | |
| 16 | ;;1.0;VIS TA SERVICE S ASSEMBLE R;****;Oct ober 1, 20 15 | |
| 17 | ; | |
| 18 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
| 19 | ; | |
| 20 | Q | |
| 21 | ;-------- - Private Methods us ed only by VISTA SER VICE ASSEM BLER ----- ----- | |
| 22 | ; | |
| 23 | ; The f unctions i n this rou tine are i nternal fo r the VSA Developmen t Team | |
| 24 | ; there is curren tly no pla n or contr act to rel ease these functions . | |
| 25 | ; No In tegration Agreements are in pl ace for th e external calls. | |
| 26 | ; | |
| 27 | BASESYM ; Baseline t he Symbol Table util ities | |
| 28 | ; Build l ocal symbo l table wi th variabl es and arr ays | |
| 29 | N SOURCE, TARGET,SUC CESS,XSADO LS,XSADOLE ,XSAZUS,XS AZUE,XSAZD IF,XSADDIF | |
| 30 | D GETSWGR ^XSAPXMU4( .XSASWGR) | |
| 31 | D GETSAML ^XSAPXMU3( .XSASAML) | |
| 32 | S (SOURCE ,TARGET)=$ NA(^%Cache Temp(63542 ,"XSA","RP C","VPR GE T PATIENT DATA")) | |
| 33 | K @SOURCE ,@TARGET | |
| 34 | S @SOURCE @("DUZ")=D UZ | |
| 35 | S @SOURCE @("PARAMS" ,1,"LITERA L")=237 | |
| 36 | S @SOURCE @("PARAMS" ,2,"LITERA L")="meds; documents" | |
| 37 | S @SOURCE @("PARAMS" ,3,"LITERA L")="" | |
| 38 | S @SOURCE @("PARAMS" ,4,"LITERA L")="" | |
| 39 | S @SOURCE @("PARAMS" ,5,"LITERA L")=40 | |
| 40 | S @SOURCE @("PARAMS" ,6,"LITERA L")="" | |
| 41 | S @SOURCE @("PARAMS" ,7,"LIST", "FILTER("" text"")")= 1 | |
| 42 | S @SOURCE @("RPC CON TEXT")="" | |
| 43 | S @SOURCE @("RPC NAM E")="VPR G ET PATIENT DATA" | |
| 44 | S SUCCESS =$$RPC^XSA PXPUB(.SOU RCE,.TARGE T) | |
| 45 | M XSAVPR= @TARGET | |
| 46 | S X="^%Ca cheTemp($J ,""DOLRO"" ," K ^%Cac heTemp($J, "DOLRO") | |
| 47 | S Y="^%Ca cheTemp($J ,""ZU160"" )" K ^%Cac heTemp($J, "ZU160") | |
| 48 | S XSADOLS =$NOW() D DOLRO^%ZOS V S XSADOL E=$NOW() | |
| 49 | S XSADDIF =$$HDIFF^X LFDT(XSADO LE,XSADOLS ,2) | |
| 50 | S XSAZUS= $NOW() S X SAZ=$ZU(16 0,1,Y) S X SAZUE=$NOW () | |
| 51 | S XSAZDIF =$$HDIFF^X LFDT(XSAZU E,XSAZUS,2 ) | |
| 52 | N CNT,GLO S CNT=0,G LO=$Q(^%Ca cheTemp($J ,"DOLRO")) F S GLO= $Q(@GLO) Q :GLO="" S CNT=CNT+1 | |
| 53 | W !!,"The re were "_ CNT_" loca l variable s in the S ymbol Tabl e." | |
| 54 | W !!,"DOL RO^%ZOSV E xecution t ime: ("_XS ADDIF_")" | |
| 55 | W !,"$ZU( 160) Execu tion time: ("_XSAZDI F_")",!! | |
| 56 | Q | |
| 57 | ; | |
| 58 | PRVU(FNAME ,LNAME,ACO DE,VCODE) ; Provisio n a user w ith First and Last n ame | |
| 59 | ;Input FN AME=First Name | |
| 60 | ; LN AME=Last N ame | |
| 61 | ; AC ODE=Access Code | |
| 62 | ; VC ODE=Verify Code | |
| 63 | N SOURCE, TARGET,X,R ETRY,RES | |
| 64 | S RETRY=3 ,RES=0 | |
| 65 | I FNAME=" " W !,"Fir st Name is required" Q | |
| 66 | I LNAME=" " W !,"Las t Name is required" Q | |
| 67 | I ACODE=" " W !,"Acc ess Code i s required " Q | |
| 68 | I VCODE=" " W !,"Ver ify Code i s required " Q | |
| 69 | S X=$$EN^ XUSHSH(ACO DE) | |
| 70 | I $D(^VA( 200,"A",X) )!$D(^VA(2 00,"AOLD", X)) W !,"T his Access Code has already be en used. T ry again." Q | |
| 71 | S SOURCE= $NA(^TMP($ J,"XSA","U SRIN")),TA RGET=$NA(^ TMP($J,"XS A","OUT")) | |
| 72 | S @SOURCE @("FNAME") =FNAME,@SO URCE@("LNA ME")=LNAME | |
| 73 | S @SOURCE @("ACODE") =ACODE,@SO URCE@("VCO DE")=VCODE | |
| 74 | F I=1:1:R ETRY Q:RES =1 S RES= $$PRVUSER( .SOURCE,.T ARGET) D | |
| 75 | . I 'RES D Q | |
| 76 | . . W !," There was a problem creating u ser",!! | |
| 77 | . . W @TA RGET@("err or","error ") | |
| 78 | . . W !," Trying aga in." | |
| 79 | . W !,"Us er ",LNAME ,",",FNAME ," created successfu lly" | |
| 80 | . W !,"DU Z: ",@TARG ET@("resul ts","DUZ") | |
| 81 | Q | |
| 82 | ; | |
| 83 | PRVUSER(SO URCE,TARGE T) ; Provi sion a new user. NAM E = LAST,F IRST | |
| 84 | ; Make su re this us er has the XUSHOWSSN Security Key | |
| 85 | N SUCCESS ,SOURCE2,T ARGET2,IEN ,IENS,FDA, XSASSN,IAM APP,XSAZZ, X,DUZ,XUSH OW,XSAUSR, XSASTOP,XS ADUZ,XSAER R | |
| 86 | D INIT^XS APXUTL(.SO URCE,.TARG ET) | |
| 87 | ; Set DUZ to someon e who has access | |
| 88 | S XUSHOW= $$LKUP^XPD KEY("XUSHO WSSN"),DUZ =1,DUZ("LO A")=2 | |
| 89 | S XSAUSR= "",XSASTOP =0 F S XS AUSR=$O(^V A(200,"B", XSAUSR)) Q :XSAUSR="" !(XSASTOP) D | |
| 90 | . S XSADU Z=$O(^VA(2 00,"B",XSA USR,0)) | |
| 91 | . Q:'$$AC TIVE^XUSER (XSADUZ) | |
| 92 | . I $D(^V A(200,XSAD UZ,51,XUSH OW)) S XSA STOP=1,DUZ =XSADUZ | |
| 93 | K @TARGET | |
| 94 | S XSAERR= 1 | |
| 95 | N X F X=" FNAME","LN AME","ACOD E","VCODE" D INITPAR M^XSAPXUTL (.X) | |
| 96 | I FNAME'] "" D Q $$ RESULT^XSA PXUTL() | |
| 97 | . D BLDER ROR^XSAPXU TL(1,"Firs t name is required", "PRVUSER^X SAPXDEV") | |
| 98 | I LNAME'] "" D Q $$ RESULT^XSA PXUTL() | |
| 99 | . D BLDER ROR^XSAPXU TL(1,"Last name is r equired"," PRVUSER^XS APXDEV") | |
| 100 | I ACODE'] "" D Q $$ RESULT^XSA PXUTL() | |
| 101 | . D BLDER ROR^XSAPXU TL(1,"Acce ss Code is required" ,"PRVUSER^ XSAPXDEV") | |
| 102 | I VCODE'] "" D Q $$ RESULT^XSA PXUTL() | |
| 103 | . D BLDER ROR^XSAPXU TL(1,"Veri fy Code is required" ,"PRVUSER^ XSAPXDEV") | |
| 104 | S X=$$EN^ XUSHSH(ACO DE) | |
| 105 | I $D(^VA( 200,"A",X) )!$D(^VA(2 00,"AOLD", X)) D Q $ $RESULT^XS APXUTL() | |
| 106 | . D BLDER ROR^XSAPXU TL(1,"This Access Co de has alr eady been used. Try again.","P RVUSER^XSA PXDEV") | |
| 107 | D OWNSKEY ^XUSRB(.XS AZZ,"XUSHO WSSN",DUZ) | |
| 108 | I 'XSAZZ( 0) S DIC(0 )="NMQ",DI C("P")="20 0.051PA",D IC="^VA(20 0,DUZ,51," ,DA(1)=DUZ ,X=$$LKUP^ XPDKEY("XU SHOWSSN"), DINUM=X D FILE^DICN | |
| 109 | ; | |
| 110 | S IAMAPP= $O(^XWB(89 94.5,"B"," IAM PROVIS IONING",0) ) | |
| 111 | I 'IAMAPP Q "0^IAM Provisioni ng is not installed. " | |
| 112 | ; | |
| 113 | ; Make su re Provisi oning Appl ication ha s the righ t Authcode | |
| 114 | I $P(^XWB (8994.5,IA MAPP,0),U, 3)'="F8GVb bchl3gV829 GL3OzBBZ3N CgvDCw7Zhs lNdz7ozY=" D | |
| 115 | . K ^TMP( "DIERR",$J ) | |
| 116 | . S DIC(0 )="",ERRMS G="" | |
| 117 | . N FDR S FDR(8994. 5,IAMAPP_" ,",.03)="F 8GVbbchl3g V829GL3OzB BZ3NCgvDCw 7ZhslNdz7o zY=" | |
| 118 | . D UPDAT E^DIE("E", "FDR","IEN ") | |
| 119 | S (SOURCE 2,TARGET2) =$NA(^TMP( $J,"XSA"," UNIT TESTS ")) | |
| 120 | K @SOURCE 2,@TARGET2 | |
| 121 | S NAME=LN AME_","_FN AME,NAME=$ $UP^XLFSTR (NAME) | |
| 122 | S XSAUSER =$O(^VA(20 0,"B",NAME ,0)) | |
| 123 | I +XSAUSE R D | |
| 124 | . S FDA(2 00,XSAUSER _",",".01" )="@" D FI LE^DIE("", "FDA","MSG ") | |
| 125 | S XSASSN= "1234"_$R( 10)_$R(10) _$R(10)_$R (10)_$R(10 ) | |
| 126 | S @SOURCE 2@("DUZ")= $G(DUZ) | |
| 127 | S @SOURCE 2@("NAME") =$$TITLE^X LFSTR(FNAM E_" "_LNAM E) | |
| 128 | S @SOURCE 2@("SECID" )=XSASSN | |
| 129 | S @SOURCE 2@("EMAIL" )=$$LOW^XL FSTR(FNAME _"."_LNAME _"@ DNS ") | |
| 130 | S @SOURCE 2@("ADUPN" )=$$LOW^XL FSTR($E(FN AME,1)_LNA ME)_"@iam. va.local" | |
| 131 | S @SOURCE 2@("SSN")= XSASSN | |
| 132 | S @SOURCE 2@("DOB")= ($R(12)+1) _"/"_($R(2 8)+1)_"/19 "_($R(99)) | |
| 133 | S @SOURCE 2@("STATIO N")=$P($$S ITE^VASITE (),"^",3) | |
| 134 | S @SOURCE 2@("AUTHCO DE")="This is my Pro visioning Code!" | |
| 135 | S @SOURCE 2@("XSASYM ")=1 | |
| 136 | S SUCCESS =$$IAMAU^X SAPXPUB(.S OURCE2,.TA RGET2) | |
| 137 | I $G(@TAR GET2@("err or","error "))]"" D Q $$RESULT ^XSAPXUTL( ) | |
| 138 | . D BLDER ROR^XSAPXU TL(1,@TARG ET2@("erro r","error" ),"PRVUSER ^XSAPXDEV" ) | |
| 139 | S IEN=$O( ^VA(200,"B ",NAME,0)) I +IEN D | |
| 140 | . S IENS= IEN_"," | |
| 141 | . S FDA(2 00,IENS,2) =$$EN^XUSH SH(ACODE) | |
| 142 | . S FDA(2 00,IENS,11 )=$$EN^XUS HSH(VCODE) | |
| 143 | . D FILE^ DIE("","FD A","MSG") I $D(MSG) ZW MSG | |
| 144 | . S DIC(0 )="NMQ",DI C("P")="20 0.051PA",D IC="^VA(20 0,IEN,51," ,DA(1)=IEN ,X=$$LKUP^ XPDKEY("XU PROG"),DIN UM=X D FIL E^DICN | |
| 145 | . S DIC(0 )="NMQ",DI C("P")="20 0.051PA",D IC="^VA(20 0,IEN,51," ,DA(1)=IEN ,X=$$LKUP^ XPDKEY("XU SHOWSSN"), DINUM=X D FILE^DICN | |
| 146 | S @TARGET @("results ","DUZ")=I EN | |
| 147 | Q XSAERR | |
| 148 | ; | |
| 149 | AGEN() ;Au to Generat e a ACCESS code | |
| 150 | N XUU,X | |
| 151 | S XUU=$$A C^XUS4 S X =$$EN^XUSH SH(XUU) I $D(^VA(200 ,"A",X))!$ D(^VA(200, "AOLD",X)) G AGEN | |
| 152 | Q XUU | |
| 153 | ; | |
| 154 | SAMLGEN(SO URCE,TARGE T) ; Mock SAML Token Generator | |
| 155 | N ERR,IEN ,IENS,MSIG ,PNUM,RES, MSG,RPC,NA ME,FNAME,L NAME,SSN,S ECID | |
| 156 | N XSAERR, RESULTS,XS ASYM,AUTHC ODE,IAMAPP | |
| 157 | D INIT^XS APXUTL(.SO URCE,.TARG ET) | |
| 158 | ; Kill th e results node | |
| 159 | K @TARGET @("results ") | |
| 160 | S XSAERR= 1 | |
| 161 | N X F X=" ESSODUZ" D INITPARM^ XSAPXUTL(. X) | |
| 162 | N I,X,XSA DT | |
| 163 | I 'ESSODU Z D Q $$R ESULT^XSAP XUTL() | |
| 164 | . D BLDER ROR^XSAPXU TL(1,"DUZ is not def ined","SAM LGEN^XSAPX DEV") | |
| 165 | ; | |
| 166 | ; Make su re this us er has the XUSHOWSSN Security Key | |
| 167 | S:'$G(DUZ ) DUZ=ESSO DUZ | |
| 168 | N XSAZZ D OWNSKEY^X USRB(.XSAZ Z,"XUSHOWS SN",DUZ) | |
| 169 | I 'XSAZZ( 0) S DIC(0 )="NMQ",DI C("P")="20 0.051PA",D IC="^VA(20 0,DUZ,51," ,DA(1)=DUZ ,X=$$LKUP^ XPDKEY("XU SHOWSSN"), DINUM=X D FILE^DICN | |
| 170 | ; | |
| 171 | S IAMAPP= $O(^XWB(89 94.5,"B"," IAM PROVIS IONING",0) ) | |
| 172 | I 'IAMAPP D Q $$RE SULT^XSAPX UTL() | |
| 173 | . D BLDER ROR^XSAPXU TL(1,"IAM Provisioni ng is not installed. ","MOCSAML ^XSAPXDEV" ) | |
| 174 | ; | |
| 175 | ; Make su re Provisi oning Appl ication ha s the righ t Authcode | |
| 176 | I $P(^XWB (8994.5,IA MAPP,0),U, 3)'="F8GVb bchl3gV829 GL3OzBBZ3N CgvDCw7Zhs lNdz7ozY=" D | |
| 177 | . K ^TMP( "DIERR",$J ) | |
| 178 | . S DIC(0 )="",ERRMS G="" | |
| 179 | . N FDR S FDR(8994. 5,IAMAPP_" ,",.03)="F 8GVbbchl3g V829GL3OzB BZ3NCgvDCw 7ZhslNdz7o zY=" | |
| 180 | . D UPDAT E^DIE("E", "FDR","IEN ") | |
| 181 | ; | |
| 182 | ; Find th e ESSO val ues for th is user | |
| 183 | S NAME=$P (^VA(200,E SSODUZ,0), U) | |
| 184 | N R D IAM FU^XUESSO3 (.R,NAME," ","","","" ,"This is my Provisi oning Code !") | |
| 185 | ; Update values if needed | |
| 186 | ; R(1)="D UZ^Name^Na meComponen ts^SSN^Dob ^AD UPN^Se cID" | |
| 187 | N XSAVAL, INARRY | |
| 188 | S XSAEDIT =0 F I=1:1 :7 S XSAVA L=$P(R(1), "^",I) I X SAVAL="" S XSAEDIT=1 Q | |
| 189 | S XSASSN= $P(R(1),U, 4),XSANM=$ P(R(1),U,3 ) | |
| 190 | I '$$SSNC HECK^XUESS O1(XSASSN) D | |
| 191 | . S XSASS N="1234"_$ R(10)_$R(1 0)_$R(10)_ $R(10)_$R( 10) | |
| 192 | . S FDR(2 00,ESSODUZ ,9)=XSASSN | |
| 193 | I XSAEDIT D | |
| 194 | . S INARR Y("SECID") =XSASSN | |
| 195 | . S INARR Y("ORGANIZ ATION_NAME ")="Depart ment of Ve terans Aff airs" | |
| 196 | . S INARR Y("ORGANIZ ATION_ID") ="urn:oid: 2.16.840.1 .113883.4. 349" | |
| 197 | . S INARR Y("EMAIL") =$P(XSANM, "`",2)_"." _$P(XSANM, "`",1)_" PII " | |
| 198 | . S INARR Y("AD_UPN" )=$P(XSANM ,"`",2)_". "_$P(XSANM ,"`",1)_" PII " | |
| 199 | . S INARR Y("SSN")=X SASSN | |
| 200 | . S INARR Y("DOB")=$ S($P(R(1), U,5)]"":$P (R(1),U,5) ,1:3020201 ) | |
| 201 | . N RES D IAMEU^XUE SSO3(.RES, .INARRY,"T his is my Provisioni ng Code!") | |
| 202 | . K R D I AMFU^XUESS O3(.R,NAME ,"","","", "","This i s my Provi sioning Co de!") | |
| 203 | . S XSASS N=$P(R(1), U,4),XSANM =$P(R(1),U ,3) | |
| 204 | ; | |
| 205 | ; Set the token exp iration da te/times t o appropri ate values | |
| 206 | S XSADT=$ $FMTHL7^XL FDT($$FMAD D^XLFDT($$ NOW^XLFDT( ),0,0,-5,0 )) | |
| 207 | S XSANOTB 4=$E(XSADT ,1,4)_"-"_ $E(XSADT,5 ,6)_"-"_$E (XSADT,7,8 )_"T"_$E(X SADT,9,10) _":"_$E(XS ADT,11,12) _":"_$E(XS ADT,13,14) | |
| 208 | S XSADT=$ $FMTHL7^XL FDT($$FMAD D^XLFDT($$ NOW^XLFDT( ),0,0,15,0 )) | |
| 209 | S XSANOTO N=$E(XSADT ,1,4)_"-"_ $E(XSADT,5 ,6)_"-"_$E (XSADT,7,8 )_"T"_$E(X SADT,9,10) _":"_$E(XS ADT,11,12) _":"_$E(XS ADT,13,14) | |
| 210 | S XSADT=$ $FMTHL7^XL FDT($$NOW^ XLFDT()) | |
| 211 | S XSAAUTH =$E(XSADT, 1,4)_"-"_$ E(XSADT,5, 6)_"-"_$E( XSADT,7,8) _"T"_$E(XS ADT,9,10)_ ":"_$E(XSA DT,11,12)_ ":"_$E(XSA DT,13,14) | |
| 212 | ; | |
| 213 | ; Now gen erate the token base d on a wor king sampl e and chan ge the val ues for th is user | |
| 214 | N X,I F I =1:1 S X=$ P($T(SAML+ I),";;",2) Q:X["$$EN D$$" D | |
| 215 | . I X["No tBefore" S @TARGET@( "results", "XSAESSO", I)=" <sam l:Conditio ns NotBefo re="""_XSA NOTB4_""" NotOnOrAft er="""_XSA NOTON_"""> " Q | |
| 216 | . I X["<s aml:AuthnS tatement A uthnInstan t=" S @TAR GET@("resu lts","XSAE SSO",I)=" <saml:Aut hnStatemen t AuthnIns tant="""_X SAAUTH_""" >" Q | |
| 217 | . I X["<s aml:Attrib uteValue>2 015-06-25T 12:00:27Z< /saml:Attr ibuteValue >" S @TARG ET@("resul ts","XSAES SO",I)=" <saml:A ttributeVa lue>"""_XS AAUTH_"""< /saml:Attr ibuteValue >" Q | |
| 218 | . I X["<s aml:Attrib uteValue>C arl</saml: AttributeV alue>" S @ TARGET@("r esults","X SAESSO",I) =" <s aml:Attrib uteValue>" _$P(XSANM, "`",2)_"</ saml:Attri buteValue> " Q | |
| 219 | . I X["<s aml:Attrib uteValue>B oden</saml :Attribute Value>" S @TARGET@(" results"," XSAESSO",I )=" < saml:Attri buteValue> "_$P(XSANM ,"`",1)_"< /saml:Attr ibuteValue >" Q | |
| 220 | . I X["<s aml:Attrib uteValue>C arl Boden< /saml:Attr ibuteValue >" S @TARG ET@("resul ts","XSAES SO",I)=" <saml: AttributeV alue>"_$P( XSANM,"`", 2)_" "_$P( XSANM,"`", 1)_"</saml :Attribute Value>" Q | |
| 221 | . I X["<s aml:Attrib uteValue>1 23459876</ saml:Attri buteValue> " S @TARGE T@("result s","XSAESS O",I)=" <saml:A ttributeVa lue>"_XSAS SN_"</saml :Attribute Value>" Q | |
| 222 | . I X["<s aml:Attrib uteValue>c boden@iam. va.local</ saml:Attri buteValue> " S @TARGE T@("result s","XSAESS O",I)=" <saml:A ttributeVa lue>"_$P(X SANM,"`",2 )_"."_$P(X SANM,"`",1 )_"@iam.va .local"_"< /saml:Attr ibuteValue >" Q | |
| 223 | . I X["<s aml:Attrib uteValue> PII </saml:Att ributeValu e>" S @TAR GET@("resu lts","XSAE SSO",I)=" <saml:Attr ibuteValue >"_$P(XSAN M,"`",2)_" ."_$P(XSAN M,"`
|
|
| 224 | . S @TARG ET@("resul ts","XSAES SO",I)=X | |
| 225 | Q $$RESUL T^XSAPXUTL () | |
| 226 | ; | |
| 227 | TFLPTLS ; Print a li st of Pati ents with their asso ciated Tre ating Faci lities | |
| 228 | ; | |
| 229 | S %ZIS="Q M" D ^%ZIS G TFLQ:PO P | |
| 230 | I $D(IO(" Q")) D Q | |
| 231 | . S ZTRTN ="TFLDQ^XS APXDV2",ZT DESC="XSA Treating F acility Up date" | |
| 232 | . D ^%ZTL OAD D HOME ^XIS K IO( "Q") Q | |
| 233 | TFLDQ ; | |
| 234 | S XSAOUT= 0 U IO | |
| 235 | S PAT=0 F S PAT=$O (^DGCN(391 .91,"B",PA T)) Q:'PAT D | |
| 236 | . D:$Y+5> IOSL RET Q :XSAOUT | |
| 237 | . W !!,"P atient Nam e: "_$P(^D PT(PAT,0), "^") | |
| 238 | . W !,?5, "DFN: "_PA T," ","I CN: ",$$GE TICN^MPIF0 01(PAT) | |
| 239 | . S TFIEN =0 F S TF IEN=$O(^DG CN(391.91, "B",PAT,TF IEN)) Q:'T FIEN D | |
| 240 | . . S TF0 =$G(^DGCN( 391.91,TFI EN,0)) | |
| 241 | . . W !,? 10,"Facili ty: ",$P(^ DIC(4,$P(T F0,U,2),0) ,U),?45,"D ate Treate d: ",$$FMT E^XLFDT($P (TF0,U,3)) | |
| 242 | D ^%ZISC | |
| 243 | Q | |
| 244 | ; | |
| 245 | TFLQ S:$D( ZTQUEUED) ZTREQ="@" Q | |
| 246 | ; | |
| 247 | RET W !! K DIR S DIR (0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)! $D(DUOUT) S XSAOUT=1 | |
| 248 | Q | |
| 249 | TFLUPD ; U pdate the Treating F acility Li st | |
| 250 | N TFIEN,P AT,DA,DIE, DIC,X,Y,FD A | |
| 251 | S DIC="^D GCN(391.91 ,",DIC(0)= "AEMQ",DIC ("A")="Sel ect TREATI NG FACILIT Y LIST Rec ord: " D ^ DIC I $D(D TOUT)!($D( DUOUT)) Q | |
| 252 | S TFIEN=+ Y,PAT=$P(Y ,U,2) | |
| 253 | K Y S DIC ="^DPT(",D IC(0)="AEM Q",DIC("A" )="PATIENT : ",DIC("B ")=$P(^DPT (PAT,0),U) D ^DIC I $D(DTOUT)! ($D(DUOUT) ) Q | |
| 254 | I +Y S FD A(391.91,T FIEN_",",. 01)=+Y | |
| 255 | K Y S DIC ="^DIC(4," ,DIC(0)="A EMQ",DIC(" A")="INSTI TUTION: ", DIC("B")=$ P(^DIC(4,$ P(^DGCN(39 1.91,TFIEN ,0),U,2),0 ),U) D ^DI C I $D(DTO UT)!($D(DU OUT)) Q | |
| 256 | I +Y S FD A(391.91,T FIEN_",",. 02)=+Y | |
| 257 | K Y S %DT ="AEST",%D T("B")=$$F MTE^XLFDT( $P(^DGCN(3 91.91,TFIE N,0),U,3)) D ^%DT | |
| 258 | I +Y S FD A(391.91,T FIEN_",",. 03)=Y | |
| 259 | D UPDATE^ DIE("","FD A","IEN") | |
| 260 | Q | |
| 261 | ; | |
| 262 | SAML ; | |
| 263 | ;;<?xml v ersion="1. 0"?> | |
| 264 | ;;<saml:A ssertion x mlns:saml= "urn:oasis :names:tc: SAML:2.0:a ssertion" ID="Assert ion-uuid60 15911c-009 5-4f17-a8f 7-aca0f9dd 8049" Vers ion="2.0" IssueInsta nt="2015-0 6-25T12:00 :27Z"> | |
| 265 | ;; <saml:Issu er Format= "urn:oasis :names:tc: SAML:2.0:n ameid-form at:entity" >https:// DNS /Issuer/SA ML2</saml: Issuer> | |
| 266 | ;; <Sign ature xmln s="http:// www.w3.org /2000/09/x mldsig#"> | |
| 267 | ;; <Si gnedInfo> | |
| 268 | ;; < Canonicali zationMeth od Algorit hm="http:/ /www.w3.or g/TR/2001/ REC-xml-c1 4n-2001031 5"/> | |
| 269 | ;; < SignatureM ethod Algo rithm="htt p://www.w3 .org/2001/ 04/xmldsig -more#rsa- sha256"/> | |
| 270 | ;; < Reference URI="#Asse rtion-uuid 6015911c-0 095-4f17-a 8f7-aca0f9 dd8049"> | |
| 271 | ;; <Transfor ms> | |
| 272 | ;; <Transf orm Algori thm="http: //www.w3.o rg/2000/09 /xmldsig#e nveloped-s ignature"/ > | |
| 273 | ;; <Transf orm Algori thm="http: //www.w3.o rg/TR/2001 /REC-xml-c 14n-200103 15"/> | |
| 274 | ;; </Transfo rms> | |
| 275 | ;; <DigestMe thod Algor ithm="http ://www.w3. org/2000/0 9/xmldsig# sha1"/> | |
| 276 | ;; <DigestVa lue>iFmvVx E9LIPWEN4U 96Z0Ya7TD2 A=</Digest Value> | |
| 277 | ;; < /Reference > | |
| 278 | ;; </S ignedInfo> | |
| 279 | ;; <Si gnatureVal ue>uoUOIi/ xDRBSvHZGs 1/4umKxJLq I+nB33QB6g hiGtWok8rQ CZ1GAUjnij +sLp1bqa3D GFSWLW/xMF Ft1myIPQzG ELvqauMu1U Aoq5T1aZOc +MSFUxcnAN 0NN5Q2UbAO kyLvy6pN0v TNR8TQ71lS ZYaLSVfFeF AfdZ9a25+Z 8DVkFMvr4+ HOm+NRZulh xUC+kqhBFR MZOfQtvFYq LE487c+ehi QvkDjLCcWi Hk2xfIR7RT IZV+67n5lT hh8xY+r3kO Iqqg0fkNBm QPy1yorLgl NYlguzsW2f 5Ne5YlqMBe mZi2YzAtzi 6Dml1ZDyh9 fQB7jpd0q4 hU/KxJ55GM WcK3w==</S ignatureVa lue> | |
| 280 | ;; <Ke yInfo> | |
| 281 | ;; < X509Data> | |
| 282 | ;; <X509Cert ificate>MI IHqjCCBpKg AwIBAgIHPQ ACACZyazAN BgkqhkiG9w 0BAQUFADBQ MRMwEQYKCZ ImiZPyLGQB GRYDZ292MR IwEAYKCZIm iZPyLGQBGR YCdmExJTAj BgNVBAMTHF ZBIEludGVy bmFsIFN1Ym 9yZGluYXRl IENBIDEwHh cNMTQxMjA5 MTUwMjM4Wh cNMTUxMjA5 MTUwMjM4Wj CBpzELMAkG A1UEBhMCVV MxCzAJBgNV BAgTAlRYMQ 8wDQYDVQQH EwZBdXN0aW 4xLDAqBgNV BAoTI1UuUy 4gRGVwYXJ0 bWVudCBvZi BWZXRlcmFu cyBBZmZhaX JzMQ4wDAYD VQQLEwVWQU FGSTEZMBcG A1UEAxMQZG V2LmVhdXRo LnZhLmdvdj EhMB8GCSqG SIb3DQEJAR YSZWF1dGhh ZG1pbnNAdm EuZ292MIIB IjANBgkqhk iG9w0BAQEF AAOCAQ8AMI IBCgKCAQEA 1qLPy2TCdC kaNSGs58Dg GpSB6EvM9m GFTbNxcdSn +4VlZ0y0xp QtcTWlyz6L YidWP9qFmf 6bRq8ah53F HAw2qkb6cw oVRDdOBBeS dsqG1OyZtU wju+XLzsJW G3t5h0J+kY Oipge7X7Yp 420Xs+oyYL 9jboeSoJTe hG0+g2CvTq roLiS6YG5u +NOTP+Ut2F CTY4cLvwR7 vIrYMb3pm3 BRqm4e8Wjz 8BVhm/GuMd P3O6ybkcg6 r9VmSXD7os q70e3iaza8 7vaFd9gMik RZu1JjlaUb ySmY2S2QQ3 IYQcwK/iPd rVIX7IjOZM sXxrK/q+ZB H7FFVdgcvg yXTXFtgmcE jwIDAQABo4 IELzCCBCsw HQYDVR0lBB YwFAYIKwYB BQUHAwEGCC sGAQUFBwMC MIICGwYDVR 0RBIICEjCC Ag6CEGRldi 5lYXV0aC52 YS5nb3aCEG ludC5lYXV0 aC52YS5nb3 aCFGludC5w a2kuZWF1dG gudmEuZ292 ghlpbnQucm VnaXN0ZXIu ZWF1dGgudm EuZ292ghlp bnQuc2Vydm ljZXMuZWF1 dGgudmEuZ2 92ghFpbnQu YWNjZXNzLn ZhLmdvdoIR cGludC5lYX V0aC52YS5n b3aCFXBpbn QucGtpLmVh dXRoLnZhLm dvdoIacGlu dC5yZWdpc3 Rlci5lYXV0 aC52YS5nb3 aCGnBpbnQu c2VydmljZX MuZWF1dGgu dmEuZ292gh JwaW50LmFj Y2Vzcy52YS 5nb3aCEHNx YS5lYXV0aC 52YS5nb3aC FHNxYS5wa2 kuZWF1dGgu dmEuZ292gh lzcWEucmVn aXN0ZXIuZW F1dGgudmEu Z292ghlzcW Euc2Vydmlj ZXMuZWF1dG gudmEuZ292 ghFzcWEuYW NjZXNzLnZh LmdvdoIUcH JlcHJvZC5l YXV0aC52YS 5nb3aCGHBy ZXByb2QucG tpLmVhdXRo LnZhLmdvdo IdcHJlcHJv ZC5yZWdpc3 Rlci5lYXV0 aC52YS5nb3 aCHXByZXBy b2Quc2Vydm ljZXMuZWF1 dGgudmEuZ2 92gh1wcmVw cm9kLnNlcn ZpY2VzLmVh dXRoLnZhLm dvdoIVcHJl cHJvZC5hY2 Nlc3MudmEu Z292MB0GA1 UdDgQWBBRj U7FmF0WMY8 NprEeudQ5Z durmzjAfBg NVHSMEGDAW gBTeJbRYCv 2TJ9qNPR86 dkt3UtlbEz CBsQYDVR0f BIGpMIGmMI GjoIGgoIGd hjBodHRwOi 8vY3JsLnBr aS52YS5nb3 YvUEtJL0NS TC9JbnRlcm 5hbFN1YkNB MS5jcmyGaW xkYXA6Ly9s ZGFwLnBraS 52YS5nb3Yv Q049SW50ZX JuYWxTdWJD QTEsQ049Q0 RQLENOPVBL SSxDTj1TZX J2aWNlcyxE Qz1WQSxEQz 1HT1Y/Y2Vy dGlmaWNhdG VSZXZvY2F0 aW9uTGlzdD B0BggrBgEF BQcBAQRoMG YwPwYIKwYB BQUHMAKGM2 h0dHA6Ly9h aWEucGtpLn ZhLmdvdi9Q S0kvQUlBL1 ZBL0ludGVy bmFsU3ViQ0 ExLmNlcjAj BggrBgEFBQ cwAYYXaHR0 cDovL29jc3 AucGtpLnZh Lmdvdi8wDA YDVR0TAQH/ BAIwADALBg NVHQ8EBAMC BaAwPQYJKw YBBAGCNxUH BDAwLgYmKw YBBAGCNxUI gcjDM4H58A aBpZ8NhOCB CIXCqksGgd uQXIewgE0C AWQCAQgwJw YJKwYBBAGC NxUKBBowGD AKBggrBgEF BQcDATAKBg grBgEFBQcD AjANBgkqhk iG9w0BAQUF AAOCAQEADu gTtZgYKdYd mda/hMoFbo tGwPb4cfVP 8sWpR7LHd/ fqTJp/CxG1 WmZ3RqJNU2 e4DZOyfln/ xVz6nxvbrG 0EthfiSHuW rUY8nldtGc N4DvAi3ZrE kBBAFUi81+ Pgtz8yE5vj pH0E6TrbcZ M7O34ZcjhS V+XO+ZBtR+ NJfdeEg4Sp oot9toaOKW zEUTvZV7DK jG57KyMLWW bqygj29Omu HXNlyBnufK GRZf4gfne8 7oglqnKdwS f5G1OX/QfE T4MIE0o4PE HNucOOuFl9 D6xj/PeSfg Dqs65uRRmL lnN9Kt94xG CsbM9yyHPD BbWkxYmAKH 7WVTXdpIlQ 8hbM53gOsQ ==</X509Ce rtificate> | |
| 283 | ;; <X509Issu erSerial> | |
| 284 | ;; <X509Is suerName>C N=VA Inter nal Subord inate CA 1 , DC=va, D C=gov</X50 9IssuerNam e> | |
| 285 | ;; <X509Se rialNumber >171699821 71804267</ X509Serial Number> | |
| 286 | ;; </X509Iss uerSerial> | |
| 287 | ;; < /X509Data> | |
| 288 | ;; </K eyInfo> | |
| 289 | ;; </Sig nature> | |
| 290 | ;; <saml :Subject> | |
| 291 | ;; <sa ml:NameID Format="ur n:oasis:na mes:tc:SAM L:2.0:name id-format: persistent ">CN=Carl Boden,CN=U sers,DC=ia m,DC=va,DC =local</sa ml:NameID> | |
| 292 | ;; <sa ml:Subject Confirmati on Method= "urn:oasis :names:tc: SAML:2.0:c m:sender-v ouches"> | |
| 293 | ;; < saml:Subje ctConfirma tionData R ecipient=" http://SSO i/AppliesT o/SAML2"/> | |
| 294 | ;; </s aml:Subjec tConfirmat ion> | |
| 295 | ;; </sam l:Subject> | |
| 296 | ;; <saml :Condition s NotBefor e="2015-06 -25T11:55: 27Z" NotOn OrAfter="2 015-06-25T 12:15:27Z" > | |
| 297 | ;; <sa ml:Audienc eRestricti on> | |
| 298 | ;; <saml:Audi ence>https ://*. DNS /*</saml:A udience> | |
| 299 | ;; </s aml:Audien ceRestrict ion> | |
| 300 | ;; </sam l:Conditio ns> | |
| 301 | ;; <saml :AuthnStat ement Auth nInstant=" 2015-06-25 T12:00:27Z "> | |
| 302 | ;; <sa ml:AuthnCo ntext> | |
| 303 | ;; < saml:Authn ContextCla ssRef>2</s aml:AuthnC ontextClas sRef> | |
| 304 | ;; </s aml:AuthnC ontext> | |
| 305 | ;; </sam l:AuthnSta tement> | |
| 306 | ;; <saml :Attribute Statement> | |
| 307 | ;; <sa ml:Attribu te Name="u rn:va:vrm: iam:transa ctionid" N ameFormat= "urn:oasis :names:tc: SAML:2.0:a ttrname-fo rmat:unspe cified"> | |
| 308 | ;; < saml:Attri buteValue> 0000000000 0000000000 00008ed2e3 0a-0674-55 8c33ab-0f6 c-00b04505 </saml:Att ributeValu e> | |
| 309 | ;; </s aml:Attrib ute> | |
| 310 | ;; <sa ml:Attribu te Name="i ssueinstan t=" NameFo rmat="urn: oasis:name s:tc:SAML: 2.0:attrna me-format: unspecifie d"> | |
| 311 | ;; < saml:Attri buteValue> 2015-06-25 T12:00:27Z </saml:Att ributeValu e> | |
| 312 | ;; </s aml:Attrib ute> | |
| 313 | ;; <sa ml:Attribu te Name="a uthnsystem " NameForm at="urn:oa sis:names: tc:SAML:2. 0:attrname -format:un specified" > | |
| 314 | ;; < saml:Attri buteValue> SSOi</saml :Attribute Value> | |
| 315 | ;; </s aml:Attrib ute> | |
| 316 | ;; <sa ml:Attribu te Name="a uthenticat iontype" N ameFormat= "urn:oasis :names:tc: SAML:2.0:a ttrname-fo rmat:unspe cified"> | |
| 317 | ;; < saml:Attri buteValue> Indirect</ saml:Attri buteValue> | |
| 318 | ;; </s aml:Attrib ute> | |
| 319 | ;; <sa ml:Attribu te Name="p roofingaut hority" Na meFormat=" urn:oasis: names:tc:S AML:2.0:at trname-for mat:unspec ified"> | |
| 320 | ;; < saml:Attri buteValue> VA</saml:A ttributeVa lue> | |
| 321 | ;; </s aml:Attrib ute> | |
| 322 | ;; <sa ml:Attribu te Name="a ssurancele vel" NameF ormat="urn :oasis:nam es:tc:SAML :2.0:attrn ame-format :unspecifi ed"> | |
| 323 | ;; < saml:Attri buteValue> 2</saml:At tributeVal ue> | |
| 324 | ;; </s aml:Attrib ute> | |
| 325 | ;; <sa ml:Attribu te Name="u rn:va:vrm: iam:firstn ame" NameF ormat="urn :oasis:nam es:tc:SAML :2.0:attrn ame-format :unspecifi ed"> | |
| 326 | ;; < saml:Attri buteValue> Carl</saml :Attribute Value> | |
| 327 | ;; </s aml:Attrib ute> | |
| 328 | ;; <sa ml:Attribu te Name="u rn:va:vrm: iam:lastna me" NameFo rmat="urn: oasis:name s:tc:SAML: 2.0:attrna me-format: unspecifie d"> | |
| 329 | ;; < saml:Attri buteValue> Boden</sam l:Attribut eValue> | |
| 330 | ;; </s aml:Attrib ute> | |
| 331 | ;; <sa ml:Attribu te Name="u rn:va:vrm: iam:secid" NameForma t="urn:oas is:names:t c:SAML:2.0 :attrname- format:uns pecified"> | |
| 332 | ;; < saml:Attri buteValue> 123459876< /saml:Attr ibuteValue > | |
| 333 | ;; </s aml:Attrib ute> | |
| 334 | ;; <sa ml:Attribu te Name="u rn:va:ad:s amaccountn ame" NameF ormat="urn :oasis:nam es:tc:SAML :2.0:attrn ame-format :unspecifi ed"> | |
| 335 | ;; < saml:Attri buteValue> cboden</sa ml:Attribu teValue> | |
| 336 | ;; </s aml:Attrib ute> | |
| 337 | ;; <sa ml:Attribu te Name="u pn" NameFo rmat="urn: oasis:name s:tc:SAML: 2.0:attrna me-format: unspecifie d"> | |
| 338 | ;; < saml:Attri buteValue> cboden@iam .va.local< /saml:Attr ibuteValue > | |
| 339 | ;; </s aml:Attrib ute> | |
| 340 | ;; <sa ml:Attribu te Name="e mail" Name Format="ur n:oasis:na mes:tc:SAM L:2.0:attr name-forma t:unspecif ied"> | |
| 341 | ;; <saml:Attr ibuteValue > PII </saml:Att ributeValu e> | |
| 342 | ;; </s aml:Attrib ute> | |
| 343 | ;; <sa ml:Attribu te Name="u rn:oasis:n ames:tc:xs pa:1.0:sub ject:subje ct-id" Nam eFormat="u rn:oasis:n ames:tc:SA ML:2.0:att rname-form at:unspeci fied"> | |
| 344 | ;; < saml:Attri buteValue> Carl Boden </saml:Att ributeValu e> | |
| 345 | ;; </s aml:Attrib ute> | |
| 346 | ;; <sa ml:Attribu te Name="u rn:oasis:n ames:tc:xa cml:2.0:su bject:role " NameForm at="urn:oa sis:names: tc:SAML:2. 0:attrname -format:un specified" > | |
| 347 | ;; < saml:Attri buteValue> role1</sam l:Attribut eValue> | |
| 348 | ;; </s aml:Attrib ute> | |
| 349 | ;; <sa ml:Attribu te Name="u rn:oasis:n ames:tc:xs pa:1.0:sub ject:organ ization" N ameFormat= "urn:oasis :names:tc: SAML:2.0:a ttrname-fo rmat:unspe cified"> | |
| 350 | ;; < saml:Attri buteValue> Department of Vetera ns Affairs </saml:Att ributeValu e> | |
| 351 | ;; </s aml:Attrib ute> | |
| 352 | ;; <sa ml:Attribu te Name="u rn:oasis:n ames:tc:xs pa:1.0:sub ject:organ ization-id " NameForm at="urn:oa sis:names: tc:SAML:2. 0:attrname -format:un specified" > | |
| 353 | ;; < saml:Attri buteValue> urn:oid:2. 16.840.1.1 13883.4.34 9</saml:At tributeVal ue> | |
| 354 | ;; </s aml:Attrib ute> | |
| 355 | ;; <sa ml:Attribu te Name="u rn:nhin:na mes:saml:h omeCommuni tyId" Name Format="ur n:oasis:na mes:tc:SAM L:2.0:attr name-forma t:unspecif ied"> | |
| 356 | ;; < saml:Attri buteValue> urn:oid:2. 16.840.1.1 13883.4.34 9</saml:At tributeVal ue> | |
| 357 | ;; </s aml:Attrib ute> | |
| 358 | ;; <sa ml:Attribu te Name="u niqueUserI d" NameFor mat="urn:o asis:names :tc:SAML:2 .0:attrnam e-format:u nspecified "> | |
| 359 | ;; < saml:Attri buteValue> 123459876< /saml:Attr ibuteValue > | |
| 360 | ;; </s aml:Attrib ute> | |
| 361 | ;; </sam l:Attribut eStatement > | |
| 362 | ;;</saml: Assertion> | |
| 363 | ;;$$END$$ | |
| 364 | Q | |
| 365 | ]]> | |
| 366 | </Routine> | |
| 367 | </Export> |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.