Changeset 1204 for ccr/trunk/p/C0CSOAP.m
- Timestamp:
- Jun 23, 2011, 3:01:41 PM (13 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CSOAP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CSOAP.m
r728 r1204 1 1 C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09 2 ;;1.0;C0C;;May 19, 2009; 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 TEST1 25 26 27 28 29 INITFARY(ARY) 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 RESTID(INNAM,INFARY) 53 54 55 56 57 58 59 60 61 62 63 TESTSOAP 64 65 66 67 68 69 70 SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 NEW 104 105 106 107 108 109 NOTNEW 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 DEMUXARY(OARY,IARY) 174 175 176 177 178 179 180 181 182 183 184 185 NORMAL(OUTXML,INXML) 186 187 188 189 190 191 192 193 194 195 196 197 MAP(RARY,IVARS,TPTR,INFARY) 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 TESTBIND 215 216 217 218 219 220 221 222 BIND(RARY,IVARS,INTPTR,INFARY) 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2008 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 W "This is an SOAP utility library",! 21 W ! 22 Q 23 ; 24 TEST1 25 S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl" 26 D GET1URL^C0CEWD2(url) 27 Q 28 ; 29 INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing 30 ; ARY is passed by name 31 S @ARY@("XML FILE NUMBER")="178.301" 32 S @ARY@("BINDING SUBFILE NUMBER")="178.3014" 33 S @ARY@("MIME TYPE")="2.3" 34 S @ARY@("PROXY SERVER")="2.4" 35 S @ARY@("REPLY TEMPLATE")=".03" 36 S @ARY@("TEMPLATE NAME")=".01" 37 S @ARY@("TEMPLATE XML")="3" 38 S @ARY@("URL")="1" 39 S @ARY@("WSDL URL")="2" 40 S @ARY@("XML")="2.1" 41 S @ARY@("XML HEADER")="2.2" 42 S @ARY@("XPATH REDUCTION STRING")="2.5" 43 S @ARY@("CCR VARIABLE")="4" 44 S @ARY@("FILEMAN FIELD NAME")="1" 45 S @ARY@("FILEMAN FIELD NUMBER")="1.2" 46 S @ARY@("FILEMAN FILE POINTER")="1.1" 47 S @ARY@("INDEXED BY")=".05" 48 S @ARY@("SQLI FIELD NAME")="3" 49 S @ARY@("VARIABLE NAME")="2" 50 Q 51 ; 52 RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME 53 ; FILE IS IDENTIFIED IN FARY, PASSED BY NAME 54 I '$D(INFARY) D ; NO FILE ARRAY PASSED 55 . S INFARY="FARY" 56 . D INITFARY(INFARY) 57 N ZN,ZREF,ZR 58 S ZN=@INFARY@("XML FILE NUMBER") 59 S ZREF=$$FILEREF^C0CRNF(ZN) 60 S ZR=$O(@ZREF@("B",INNAM,"")) 61 Q ZR 62 ; 63 TESTSOAP ; 64 ; USING ICD9 WEB SERVICE TO TEST SOAP 65 S G("CODE")="E*" 66 S G("CODELN")=3 67 D SOAP("GPL","ICD9","G") 68 Q 69 ; 70 SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR 71 ; TEMPLATE ID C0CTID 72 ; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME 73 ; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND 74 ; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED 75 ; BEFORE MAPPING 76 ; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND 77 ; ALTXML WILL BE USED INSTEAD 78 ; 79 ; ARTIFACTS SECTION 80 ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE 81 ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS 82 ; WILL NOT BE NEWED. 83 I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS 84 S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")="" 85 S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")="" 86 S C0CV(300,"HEADER","SOAP HEADER")="" 87 S C0CV(400,"C0CMIME","MIME TYPE")="" 88 S C0CV(500,"C0CURL","WS URL")="" 89 S C0CV(550,"C0CPURL","PROXY URL")="" 90 S C0CV(600,"C0CXML","XML VARIABLE NAME")="" 91 S C0CV(700,"XML","OUTBOUND XML")="" 92 S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")="" 93 S C0CV(900,"C0CRHDR","RETURNED HEADER")="" 94 S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")="" 95 S C0CV(1100,"C0CR","REPLY TEMPLATE")="" 96 S C0CV(1200,"C0CREDUX","REDUX STRING")="" 97 S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")="" 98 S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")="" 99 S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")="" 100 S C0CV(1600,"C0CID","RESULT DOM ID")="" 101 I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG 102 N ZI,ZJ S ZI="" 103 NEW 104 S ZI=$O(C0CV(ZI)) 105 S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND 106 ;W ZJ,! 107 N @ZJ ; NEW THE VARIABLE 108 I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT 109 NOTNEW 110 ; END ARTIFACTS 111 ; 112 I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS 113 E D ; 114 . K C0CF 115 . M C0CF=@IFARY 116 S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE 117 I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME 118 . S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME 119 E S C0CUTID=C0CTID ; AN IEN WAS PASSED 120 N XML,TEMPLATE,HEADER 121 N C0CFH S C0CFH=C0CF("XML HEADER") 122 S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER") 123 N C0CFM S C0CFM=C0CF("MIME TYPE") 124 S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM) 125 N C0CFP S C0CFP=C0CF("PROXY SERVER") 126 S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP) 127 N C0CFU S C0CFU=C0CF("URL") 128 S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU) 129 N C0CFX S C0CFX=C0CF("XML") 130 S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML") 131 N C0CFT S C0CFT=C0CF("TEMPLATE XML") 132 S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE") 133 I C0CTMPL="TEMPLATE" D ; there is a template to process 134 . K XML ; going to replace the xml array 135 . N VARS 136 . I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides 137 . I '$D(ALTXML) D ; if ALTXML is passed in, don't bind 138 . . D BIND("VARS",C0CVA,C0CUTID,"C0CF") 139 . . D MAP("XML","VARS",TPTR,"C0CF") 140 . . K XML(0) 141 . E M XML=@ALTXML ; use ALTXML instead 142 I $G(C0CPROXY) S C0CURL=C0CPURL 143 K C0CRSLT,C0CRHDR 144 B 145 S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR) 146 K C0CRXML 147 D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY 148 N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE")) 149 S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE 150 ; reply templates are optional and are specified by populating a 151 ; template pointer in field 2.5 of the request template 152 ; if specified, the reply template is the source of the REDUX string 153 ; used for XPath on the reply, and for UNBIND processing 154 ; if no reply template is specified, REDUX is obtained from the request 155 ; template and no UNBIND processing is performed. The XPath array is 156 ; returned without variable bindings 157 I C0CR'="" D ; REPLY TEMPLATE EXISTS 158 . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,! 159 . S C0CTID=C0CR ; 160 N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING") 161 S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING 162 K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS 163 S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM 164 S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER 165 S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE 166 D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR 167 ; Next, call UNBIND to map the reply XPath array to variables 168 ; This is only done if a Reply Template is provided 169 D DEMUXARY(C0CRTN,"C0CARY") 170 ; M @C0CRTN=C0CARY 171 Q 172 ; 173 DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO 174 ; FORMAT @OARY@(x,xpath) where x is the first multiple 175 N ZI,ZJ,ZK,ZL S ZI="" 176 F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; 177 . D DEMUX^C0CMXP("ZJ",ZI) 178 . S ZK=$P(ZJ,"^",3) 179 . S ZK=$RE($P($RE(ZK),"/",1)) 180 . S ZL=$P(ZJ,"^",1) 181 . I ZL="" S ZL=1 182 . S @OARY@(ZL,ZK)=@IARY@(ZI) 183 Q 184 ; 185 NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML 186 ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME 187 ; 188 N ZI,ZN,ZTMP 189 S ZN=1 190 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" 191 S ZN=ZN+1 192 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; 193 . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" 194 . S ZN=ZN+1 195 Q 196 ; 197 MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME 198 ; IVARS IS AN XPATH ARRAY PASSED BY NAME 199 ; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE 200 ; 201 N ZT ;THE TEMPLATE 202 K ZT,@RARY 203 I '$D(INFARY) D ; 204 . S INFARY="FARY" 205 . D INITFARY(INFARY) 206 N ZF,ZFT 207 S ZF=@INFARY@("XML FILE NUMBER") 208 S ZFT=@INFARY@("TEMPLATE XML") 209 I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE 210 . W "ERROR RETRIEVING TEMPLATE",! 211 D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING 212 Q 213 ; 214 TESTBIND ; 215 S G1("TESTONE")=1 216 S G1("TESTTWO")=2 217 D BIND("G","G1","TEST") 218 W ! 219 ZWR G 220 Q 221 ; 222 BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP 223 ; TO BUILD AN INSTANTIATED TEMPLATE 224 ; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE 225 ; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND 226 ; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES 227 ; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME 228 I '$D(INFARY) D ; 229 . S INFARY="FARY" 230 . D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED 231 I +INTPTR>0 S TPTR=INTPTR 232 E S TPTR=$$RESTID(INTPTR,INFARY) 233 N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF 234 S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file 235 S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file 236 S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER 237 S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings 238 I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index 239 ; this needs to be a whole file index on the XPath subfile with 240 ; the Template IEN perceding the XPath in the index 241 N ZI 242 S ZI="" 243 S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is 244 ;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH 245 F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template 246 . ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,"")) 247 . N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ; 248 . S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD 249 . N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER") 250 . S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I") 251 . N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER") 252 . S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I") 253 . N ZFV S ZFV=@INFARY@("VARIABLE NAME") 254 . S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E") 255 . N ZFX S ZFX=("INDEXED BY") 256 . S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I") 257 . S ZINDEX="" 258 . I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ 259 . I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN 260 . E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable 261 . ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT 262 . ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION 263 . I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS 264 . . S @RARY@(ZI)=@IVARS@(ZVAR) ; 265 . E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN 266 . . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE 267 . . D CLEAN^DILF 268 . . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE 269 . . I $D(^TMP("DIERR",$J,1)) D B ; 270 . . . W "ERROR!",! 271 . . . ZWR ^TMP("DIERR",$J,*) 272 Q 273 ;
Note:
See TracChangeset
for help on using the changeset viewer.
