C0PWS1 ; ERX/GPL - Web Service utilities; 8/31/09 ; 5/9/12 12:14am ;;1.0;C0P;;Apr 25, 2012;Build 103 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU ;General Public License See attached copy of the License. ; ;This program is free software; you can redistribute it and/or modify ;it under the terms of the GNU General Public License as published by ;the Free Software Foundation; either version 2 of the License, or ;(at your option) any later version. ; ;This program is distributed in the hope that it will be useful, ;but WITHOUT ANY WARRANTY; without even the implied warranty of ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;GNU General Public License for more details. ; ;You should have received a copy of the GNU General Public License along ;with this program; if not, write to the Free Software Foundation, Inc., ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ; Q ; ; TEST Lines below not intended for End Users. Programmers only. ; BEWARE ZWRITE SYNTAX. It may not work in other M Implementations. TEST(C0PDUZ,C0PDFN) ; TEST RETRIEVAL OF PATIENT1 MEDS ;S DEBUG=1 ; D SOAP("C0POUT",6,C0PDUZ,C0PDFN) ZWRITE C0POUT Q ; ACCOUNTF() Q 113059002 ; file number for account file XMLFN() Q 113059001 ; XML TEMPLATE FILE NUMBER BINDFN() Q 113059001.04 ; FILE NUMBER FOR BINDING SUBFILE ; GETTID(C0PWS,C0PTNAME) ; EXTRINSIC WHICH RETURNS THE TEMPLATE ID FOR ; TEMPLATE NAMED C0PTNAME BELONGING TO WEB SERVICE NAMED C0PWS ; ALSO WORKS IF THE ACCOUNT NUMBER IS PASSED IN C0PWS S C0PXF=113059001 ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE S C0PAF=113059002 ; FILE NUMBER FOR THE C0P WS ACCT FILE N C0PA,C0PT ; C0P ACCOUNT AND C0P TEMPLATE I C0PWS>0 S C0PA=C0PWS E D ; NAME NOT RECORD NUMBER IS PASSED FOR ACCOUNT . S C0PA=$O(^C0PS("B",C0PWS,"")) ; RECORD NUMBER OF ACCOUNT . I C0PA="" D Q ; OOPS ACCOUNT NOT FOUND . . W "ACCOUNT "_C0PWS_" NOT FOUND",! S C0PT=$O(^C0PX("C",C0PA,C0PTNAME,"")) ; RECORD NUMBER OF TEMPLATE ; WE USE THE C INDEX TO INSURE THAT THE TEMPLATE BELONGS TO THE WEB SERVICE Q C0PT ; RESTID(C0PDUZ,C0PTID) ; RESOLVE TEMPLATE ID FROM SUBSCRIPTION ; N C0PAIEN S C0PAIEN=$$SUBINIT^C0PSUB(C0PDUZ) ;IEN OF SUBSCRIPTION N C0PACCT S C0PACCT=$$GET1^DIQ(C0PSUBF,C0PAIEN_","_C0PDUZ_",",1,"I") ;ACCT N C0PWBS S C0PWBS=$$GET1^DIQ(C0PAF,C0PACCT_",",4,"I") ;WEB SERVICE IEN N C0PUTID S C0PUTID=$$GETTID(C0PWBS,C0PTID) ;TEMPLATE ID Q C0PUTID ; SOAP(C0PRTN,C0PTID,C0PDUZ,C0PDFN,C0PVOR) ; MAKES A SOAP CALL FOR ; TEMPLATE ID C0PTID ; RETURNS THE XML RESULT IN C0PRTN, PASSED BY NAME ; C0PVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED ; BEFORE MAPPING ; ; ARTIFACTS SECTION ; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE ; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS ; WILL NOT BE NEWED. I $G(DEBUG)="" N C0PV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS S C0PV(100,"C0PXF","XML TEMPLATE FILE NUMBER")="" S C0PV(200,"C0PHEAD","SOAP HEADER VARIABLE NAME")="" S C0PV(300,"header","SOAP HEADER")="" S C0PV(400,"C0PMIME","MIME TYPE")="" S C0PV(500,"C0PURL","WS URL")="" S C0PV(550,"C0PPURL","PROXY URL")="" S C0PV(600,"C0PXML","XML VARIABLE NAME")="" S C0PV(700,"xml","OUTBOUND XML")="" S C0PV(800,"C0PRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")="" S C0PV(900,"C0PRHDR","RETURNED HEADER")="" S C0PV(1000,"C0PRXML","XML RESULT NORMALIZED")="" S C0PV(1100,"C0PR","REPLY TEMPLATE")="" S C0PV(1200,"C0PREDUX","REDUX STRING")="" S C0PV(1300,"C0PIDX","RESULT XPATH INDEX")="" S C0PV(1400,"C0PARY","RESULT XPATH ARRAY")="" S C0PV(1500,"C0PNOM","RESULT DOM DOCUMENT NAME")="" S C0PV(1600,"C0PID","RESULT DOM ID")="" I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG N ZI,ZJ S ZI="" NEW ; new the variables S ZI=$O(C0PV(ZI)) S ZJ=$O(C0PV(ZI,"")) ; SET UP NEW COMMAND ;W ZJ,! N @ZJ ; NEW THE VARIABLE I $O(C0PV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT NOTNEW ; (goto label) don't new the variables... skip that ; END ARTIFACTS ; D INITXPF("C0PF") ; SET FILE NUMBER AND PARAMATERS S C0PXF=C0PF("XML FILE NUMBER") ; FILE NUMBER FOR THE C0P XML TEMPLATE FILE I +C0PTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME . S C0PUTID=$$RESTID(C0PDUZ,C0PTID) ;RESOLVE TEMPLATE IEN FROM NAME E S C0PUTID=C0PTID ; AN IEN WAS PASSED N xml,template,header S C0PHEAD=$$GET1^DIQ(C0PXF,C0PUTID_",",2.2,,"header") S C0PMIME=$$GET1^DIQ(C0PXF,C0PUTID_",","MIME TYPE") S C0PPURL=$$GET1^DIQ(C0PXF,C0PUTID_",","PROXY SERVER") ;S C0PURL=$$GET1^DIQ(C0PXF,C0PUTID_",","URL") ;GPL CHANGE TO USE PROD FLAG D SETUP^C0PMAIN() ; INITIALIZE C0PACCT IEN OF WS ACCOUNT S C0PURL=$$WSURL^C0PMAIN(C0PACCT) ; RESOLVES PRODUCTION VS TEST S C0PXML=$$GET1^DIQ(C0PXF,C0PUTID_",",2.1,,"xml") S C0PTMPL=$$GET1^DIQ(C0PXF,C0PUTID_",",3,,"template") I C0PTMPL="template" D ; there is a template to process . K xml ; going to replace the xml array . D EN^C0PMAIN("xml","url",C0PDUZ,C0PDFN,C0PUTID,$G(C0PVOR)) . ;N ZZG M ZZG(1)=xml . ;S ZDIR=^TMP("C0CCCR","ODIR") . ;ZWR ZZG(1) . ;W $$OUTPUT^C0CXPATH("xml(1)","GPLTEST-"_ZDFN_".xml",ZDIR) I $G(C0PPROXY) S C0PURL=C0PPURL I '$D(C0PERROR) S C0PERROR="0^NO ERRORS" ; to do: start using this gpl K C0PRSLT,C0PRHDR ; ; token to catch runaway linux jobs - gpl 4/12/2012 ; But not ready for release b/c depends on code that is not available --smh 5/9/12 ; D LOG^C0PTRAK($J,"PULLBACK") ; S ok=$$httpPOST^%zewdGTM(C0PURL,.xml,C0PMIME,.C0PRSLT,.header,"",.gpl5,.C0PRHDR) ; ; kill token after return from EWD ; ;D UNLOG^C0PTRAK($J) ; success, remove the token ; smh commented out 5/9/12 ;K ^TMP("C0PERX",$J) K C0PRXML ;I DUZ=135 B ; patch so others can use the pullback while i debug - gpl ;. ;I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY ;. I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY ;. ; SWITCHED TO CHUNK TO HANDLE ARRAYS OF XML ;E I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY ; The following is a temporary fix to keep eRx working while a better ; solution is developed. Template ID 6 is GETMEDS for eRx and it needs ; to handle xml files that are too big for NORMAL to handle. So, I wrote ; CHUNK which will allow us to handle any size xml file bound for the ; EWD parser. ; However, all the other templates in eRx need NORMAL to find the ; embedded XML file in their web service responses. So, we will use ; CHUNK for template 6 and continue to use NORMAL for all other templates ; we can handle big med lists, but not big web service calls. ; What is needed is a better NORMAL (see NORMAL2) or another routine ; to detect, extract, and decode embeded XML files of any size. gpl 10/8/10 I C0PUTID=6 D ; . I $D(C0PRSLT(1)) D CHUNK("C0PRXML","C0PRSLT",2000) ;RETURN IN AN ARRAY E I $D(C0PRSLT(1)) D NORMAL("C0PRXML","C0PRSLT(1)") ;RETURN XML IN AN ARRAY S C0PR=$$GET1^DIQ(C0PXF,C0PUTID_",",.03,"I") ; REPLY TEMPLATE ; reply templates are optional and are specified by populating a ; template pointer in field 2.5 of the request template ; if specified, the reply template is the source of the REDUX string ; used for XPath on the reply, and for UNBIND processing ; if no reply template is specified, REDUX is obtained from the request ; template and no UNBIND processing is performed. The XPath array is ; returned without variable bindings I C0PR'="" D ; REPLY TEMPLATE EXISTS . I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0PR,! . S C0PTID=C0PR ; S C0PREDUX=$$GET1^DIQ(C0PXF,C0PUTID_",",2.5) ;XPATH REDUCTION STRING K C0PIDX,C0PARY ; XPATH INDEX AND ARRAY VARS S C0PNOM="C0PMEDS"_$J ; DOCUMENT NAME FOR THE DOM N ZBIG S ZBIG=0 I C0PUTID'=6 D ; . S ZBIG=$$TOOBIG("C0PRXML") ; PATCH BY GPL WHICH ASSUMES ONLY . ; TEMPLATE 1 IS A REGULAR XML FILE.. EVERYTHING ELSE HAS EMBEDDED XML I ZBIG>0 D ; PROBABLY AN EMBEDDED XML DOCUMENT . S C0PID=$$UNWRAP("C0PRXML",ZBIG,C0PNOM) ; DECODE AND PARSE THE EMBEDED XML E S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER ;S C0PID=$$PARSE^C0PXEWD("C0PRXML",C0PNOM) ;CALL THE PARSER S C0PID=$$FIRST^C0PXEWD($$ID^C0PXEWD(C0PNOM)) ;ID OF FIRST NODE D XPATH^C0PXEWD(C0PID,"/","C0PIDX","C0PARY","",C0PREDUX) ;XPATH GENERATOR S OK=$$DELETE^C0PXEWD(C0PNOM) ; REMOVE PARSED XML FROM THE EWD DOM ; Next, call UNBIND to map the reply XPath array to variables ; This is only done if a Reply Template is provided D DEMUXARY(C0PRTN,"C0PARY") ; M @C0PRTN=C0PARY Q ; TOOBIG(ZXML) ; EXTRINSIC WHICH RETURNS TRUE IF ANY NODE IS OVER 2000 CHARS ; RETURNS THE INDEX OF THE LARGE NODE . IF NO LARGE NODE, RETURNS ZERO N ZI,ZR S ZI="" S ZR=0 ; DEFAULT FALSE F S ZI=$O(@ZXML@(ZI)) Q:ZI="" D ; . I $L(@ZXML@(ZI))>1000 S ZR=ZI Q ZR ; NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML ; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME ; N ZI,ZN,ZTMP S ZN=1 S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">" S ZN=ZN+1 F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ; . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" . S ZN=ZN+1 Q ; CHUNK(OUTXML,INXML,ZSIZE) ; BREAKS INXML INTO ZSIZE BLOCKS ; INXML IS AN ARRAY PASSED BY NAME OF STRINGS ; OUTXML IS ALSO PASSED BY NAME ; IF ZSIZE IS NOT PASSED, 1000 IS USED I '$D(ZSIZE) S ZSIZE=1000 ; DEFAULT BLOCK SIZE N ZB,ZI,ZJ,ZK,ZL,ZN S ZB=ZSIZE-1 S ZN=1 S ZI=0 ; BEGINNING OF INDEX TO INXML F S ZI=$O(@INXML@(ZI)) Q:+ZI=0 D ; FOR EACH STRING IN INXML . S ZL=$L(@INXML@(ZI)) ; LENGTH OF THE STRING . F ZJ=1:ZSIZE:ZL D ; . . S ZK=$S(ZJ+ZB<",ZN)_">" . S ZN=ZN+1 . F S @OUTXML@(ZN)="<"_$P(@INXML@(ZJ),"><",ZN) Q:$P(@INXML@(ZJ),"><",ZN+1)="" D ; . . S @OUTXML@(ZN)=@OUTXML@(ZN)_">" . . S ZN=ZN+1 Q ; UNWRAP(ZXML,ZI,ZNOM) ; EXTRINSIC TO LOCATE, DECODE AND PARSE AN EMBEDED XML DOC ; RETURNS THE DOCID OF THE DOM N ZS,ZX S ZS=$P($P(@ZXML@(ZI),">",2),"<",1) ; PULL OUT THE ENCODED STRING S ZX=$$DECODE^RGUTUU(ZS) N ZZ N ZY S ZY="" I $E(ZX,1,5)'="