MPIFHWSC ;OAK/ELZ - MPIF HEALTHEVET WEB SERVICES CLIENT TOOLS ;3 APR 2012
;;1.0;MASTER PATIENT INDEX VISTA;**56,61,63**;30 Apr 99;Build 2
;
ENV ; - environment check entry (first time with this patch only)
; this tag area can be removed with future patches
; future patches can call the $$CKSETUP^MPIFHWSC entry for environment
; check
S X=$$CKSETUP("PSIMWSEXECUTE.WSDL")
Q
;
POSTINT ; -- setup (first time with this patch only)
; this tag area can be removed with future patches
; future patches can call the DO SETUP^MPIFHWSC entry for post-init to setup a new HWSC 18.02 entry
D SETUP("PSIMWSEXECUTE.WSDL","MPI_PSIM_EXECUTE")
Q
;
CKSETUP(MPIWSDL) ; - used to check the environment
; returns the path to be used that was verified or 0 if it fails
;
; $$DEFDIR^%ZISH,$$LIST^%ZISH - #2320
; BMES^XPDUTL - #10141
;
N MPISTAT,MPIPATH,MPIFILE
S MPIPATH=$$DEFDIR^%ZISH()
S MPIFILE(MPIWSDL)=""
S MPISTAT=$$LIST^%ZISH(MPIPATH,"MPIFILE","MPISTAT")
I 'MPISTAT!($D(MPISTAT)'=11),'$D(XPDENV) D Q 0
.D BMES^XPDUTL("**** Error cannot find file "_MPIPATH_MPIWSDL)
I 'MPISTAT!($D(MPISTAT)'=11) D Q 0
.W !!,"**** WSDL file "_MPIWSDL_" not found in "_MPIPATH_"."
.W !," You will need that prior to install."
.S XPDQUIT=2
Q MPIPATH
;
SETUP(MPIWSDL,MPISERV) ; -- call to setup hwsc
;MPIWSDL - call with the wsdl file to setup, must be in the kernel default directory
;
; $$GENPORT^XOBWLIB - #5421
;
N MPISTAT,MPIPATH,MPIARR
S MPIPATH=$$CKSETUP(MPIWSDL) I MPIPATH=0 Q
S MPIFILE(MPIWSDL)=""
S MPIARR("WSDL FILE")=MPIPATH_MPIWSDL
S MPIARR("CACHE PACKAGE NAME")="MPIPSIM"
S MPIARR("WEB SERVICE NAME")=MPISERV
S MPIARR("AVAILABILITY RESOURCE")="?wsdl"
S MPISTAT=$$GENPORT^XOBWLIB(.MPIARR)
;
I 'MPISTAT D BMES^XPDUTL("**** Error creating Web Service (#18.02)"_MPISERV),MES^XPDUTL(MPISTAT) Q
D BMES^XPDUTL(">>> "_MPISERV_" entry added to WEB SERVICE file #18.02")
D BMES^XPDUTL(" - Be sure and set up the Web Server as in the post-install instructions!!")
;
Q
;
POST(MPIXML,MPIXMLR) ; - post XML to the execute server
; $$GETPROXY^XOBWLIB - #5421
N $ETRAP,$ESTACK,SVC
; set error trap
S $ETRAP="DO ERROR^MPIFHWSC"
; test mode (outgoing)?
I $D(^XTMP("MPIFXML EDIT")) D TEST("OUTGOING",.MPIXML)
; make the call
;**63 STORY 317469 HTTPS OR HTTP
N IEN,HTTPS S IEN=$O(^MPIF(984.8,"B","TWO","")),HTTPS=$P($G(^MPIF(984.8,IEN,0)),"^",4)
I HTTPS=0!(HTTPS="") S SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_EXECUTE","MPI_PSIM_EXECUTE")
I HTTPS=1 S SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
S MPIXMLR=SVC.execute(MPIXML)
; in case debugging needed, save both out and return
I $D(^XTMP("MPIFHWSC")) D
.N MPIFSAVE
.S MPIFSAVE=$O(^XTMP("MPIFHWSC",":"),-1)+1
.S ^XTMP("MPIFHWSC",MPIFSAVE,0)=$$NOW^XLFDT
.S ^XTMP("MPIFHWSC",MPIFSAVE,"OUT")=MPIXML
.S ^XTMP("MPIFHWSC",MPIFSAVE,"RETURN")=MPIXMLR
; test mode (return)?
I $D(^XTMP("MPIFXML EDIT")) D TEST("RETURN",.MPIXMLR)
Q
;
ERROR ; - catch errors
; Set ecode to empty to return to calling function
;
; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - #5421
; UNWIND^%ZTER - #1621
N MPIERR
S MPIERR=$$EOFAC^XOBWLIB()
D ZTER^XOBWLIB(MPIERR)
S $ECODE=""
D UNWIND^%ZTER
Q
;
TEST(TYPE,MPIXML) ; - call to possibly edit the xml string
; used for testing purposes only.
; production NOT allowed
I $$PROD^XUPROD Q
I $E($G(IOST),1,2)'="C-" Q
;
N X,S,L,T,C,%,%Y
W !!,"Do you want to edit the "_TYPE_" XML"
S %=2 D YN^DICN I %'=1 Q
K ^TMP("MPIFXMLT",$J)
S L=0,T=""
F X=1:1 S C=$E(MPIXML,X) Q:C="" D
. I C="<",T'="" S L=L+1,^TMP("MPIFXMLT",$J,L,0)=T,T=C Q
. S T=T_C
S DIC="^TMP(""MPIFXMLT"",$J,"
D EN^DIWE
S MPIXML=""
S X=0 F S X=$O(^TMP("MPIFXMLT",$J,X)) Q:'X S MPIXML=MPIXML_^TMP("MPIFXMLT",$J,X,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFHWSC 3820 printed Dec 13, 2024@02:11:13 Page 2
MPIFHWSC ;OAK/ELZ - MPIF HEALTHEVET WEB SERVICES CLIENT TOOLS ;3 APR 2012
+1 ;;1.0;MASTER PATIENT INDEX VISTA;**56,61,63**;30 Apr 99;Build 2
+2 ;
ENV ; - environment check entry (first time with this patch only)
+1 ; this tag area can be removed with future patches
+2 ; future patches can call the $$CKSETUP^MPIFHWSC entry for environment
+3 ; check
+4 SET X=$$CKSETUP("PSIMWSEXECUTE.WSDL")
+5 QUIT
+6 ;
POSTINT ; -- setup (first time with this patch only)
+1 ; this tag area can be removed with future patches
+2 ; future patches can call the DO SETUP^MPIFHWSC entry for post-init to setup a new HWSC 18.02 entry
+3 DO SETUP("PSIMWSEXECUTE.WSDL","MPI_PSIM_EXECUTE")
+4 QUIT
+5 ;
CKSETUP(MPIWSDL) ; - used to check the environment
+1 ; returns the path to be used that was verified or 0 if it fails
+2 ;
+3 ; $$DEFDIR^%ZISH,$$LIST^%ZISH - #2320
+4 ; BMES^XPDUTL - #10141
+5 ;
+6 NEW MPISTAT,MPIPATH,MPIFILE
+7 SET MPIPATH=$$DEFDIR^%ZISH()
+8 SET MPIFILE(MPIWSDL)=""
+9 SET MPISTAT=$$LIST^%ZISH(MPIPATH,"MPIFILE","MPISTAT")
+10 IF 'MPISTAT!($DATA(MPISTAT)'=11)
IF '$DATA(XPDENV)
Begin DoDot:1
+11 DO BMES^XPDUTL("**** Error cannot find file "_MPIPATH_MPIWSDL)
End DoDot:1
QUIT 0
+12 IF 'MPISTAT!($DATA(MPISTAT)'=11)
Begin DoDot:1
+13 WRITE !!,"**** WSDL file "_MPIWSDL_" not found in "_MPIPATH_"."
+14 WRITE !," You will need that prior to install."
+15 SET XPDQUIT=2
End DoDot:1
QUIT 0
+16 QUIT MPIPATH
+17 ;
SETUP(MPIWSDL,MPISERV) ; -- call to setup hwsc
+1 ;MPIWSDL - call with the wsdl file to setup, must be in the kernel default directory
+2 ;
+3 ; $$GENPORT^XOBWLIB - #5421
+4 ;
+5 NEW MPISTAT,MPIPATH,MPIARR
+6 SET MPIPATH=$$CKSETUP(MPIWSDL)
IF MPIPATH=0
QUIT
+7 SET MPIFILE(MPIWSDL)=""
+8 SET MPIARR("WSDL FILE")=MPIPATH_MPIWSDL
+9 SET MPIARR("CACHE PACKAGE NAME")="MPIPSIM"
+10 SET MPIARR("WEB SERVICE NAME")=MPISERV
+11 SET MPIARR("AVAILABILITY RESOURCE")="?wsdl"
+12 SET MPISTAT=$$GENPORT^XOBWLIB(.MPIARR)
+13 ;
+14 IF 'MPISTAT
DO BMES^XPDUTL("**** Error creating Web Service (#18.02)"_MPISERV)
DO MES^XPDUTL(MPISTAT)
QUIT
+15 DO BMES^XPDUTL(">>> "_MPISERV_" entry added to WEB SERVICE file #18.02")
+16 DO BMES^XPDUTL(" - Be sure and set up the Web Server as in the post-install instructions!!")
+17 ;
+18 QUIT
+19 ;
POST(MPIXML,MPIXMLR) ; - post XML to the execute server
+1 ; $$GETPROXY^XOBWLIB - #5421
+2 NEW $ETRAP,$ESTACK,SVC
+3 ; set error trap
+4 SET $ETRAP="DO ERROR^MPIFHWSC"
+5 ; test mode (outgoing)?
+6 IF $DATA(^XTMP("MPIFXML EDIT"))
DO TEST("OUTGOING",.MPIXML)
+7 ; make the call
+8 ;**63 STORY 317469 HTTPS OR HTTP
+9 NEW IEN,HTTPS
SET IEN=$ORDER(^MPIF(984.8,"B","TWO",""))
SET HTTPS=$PIECE($GET(^MPIF(984.8,IEN,0)),"^",4)
+10 IF HTTPS=0!(HTTPS="")
SET SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_EXECUTE","MPI_PSIM_EXECUTE")
+11 IF HTTPS=1
SET SVC=$$GETPROXY^XOBWLIB("MPI_PSIM_NEW EXECUTE","MPI_PSIM_NEW EXECUTE")
+12 SET MPIXMLR=SVC.execute(MPIXML)
+13 ; in case debugging needed, save both out and return
+14 IF $DATA(^XTMP("MPIFHWSC"))
Begin DoDot:1
+15 NEW MPIFSAVE
+16 SET MPIFSAVE=$ORDER(^XTMP("MPIFHWSC",":"),-1)+1
+17 SET ^XTMP("MPIFHWSC",MPIFSAVE,0)=$$NOW^XLFDT
+18 SET ^XTMP("MPIFHWSC",MPIFSAVE,"OUT")=MPIXML
+19 SET ^XTMP("MPIFHWSC",MPIFSAVE,"RETURN")=MPIXMLR
End DoDot:1
+20 ; test mode (return)?
+21 IF $DATA(^XTMP("MPIFXML EDIT"))
DO TEST("RETURN",.MPIXMLR)
+22 QUIT
+23 ;
ERROR ; - catch errors
+1 ; Set ecode to empty to return to calling function
+2 ;
+3 ; $$EOFAC^XOBWLIB, ZTER^XOBWLIB - #5421
+4 ; UNWIND^%ZTER - #1621
+5 NEW MPIERR
+6 SET MPIERR=$$EOFAC^XOBWLIB()
+7 DO ZTER^XOBWLIB(MPIERR)
+8 SET $ECODE=""
+9 DO UNWIND^%ZTER
+10 QUIT
+11 ;
TEST(TYPE,MPIXML) ; - call to possibly edit the xml string
+1 ; used for testing purposes only.
+2 ; production NOT allowed
+3 IF $$PROD^XUPROD
QUIT
+4 IF $EXTRACT($GET(IOST),1,2)'="C-"
QUIT
+5 ;
+6 NEW X,S,L,T,C,%,%Y
+7 WRITE !!,"Do you want to edit the "_TYPE_" XML"
+8 SET %=2
DO YN^DICN
IF %'=1
QUIT
+9 KILL ^TMP("MPIFXMLT",$JOB)
+10 SET L=0
SET T=""
+11 FOR X=1:1
SET C=$EXTRACT(MPIXML,X)
if C=""
QUIT
Begin DoDot:1
+12 IF C="<"
IF T'=""
SET L=L+1
SET ^TMP("MPIFXMLT",$JOB,L,0)=T
SET T=C
QUIT
+13 SET T=T_C
End DoDot:1
+14 SET DIC="^TMP(""MPIFXMLT"",$J,"
+15 DO EN^DIWE
+16 SET MPIXML=""
+17 SET X=0
FOR
SET X=$ORDER(^TMP("MPIFXMLT",$JOB,X))
if 'X
QUIT
SET MPIXML=MPIXML_^TMP("MPIFXMLT",$JOB,X,0)
+18 QUIT
