ORPDMPWS.m

ORPDMPWS ;ISP/LMT - PDMP Web Service APIs ;Nov 04, 2020@14:19:06

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,498**;Dec 17, 1997;Build 38

 ;

 ; SAC EXEMPTION 20200131-02 : non-ANSI standard M code

 ;

 ; This routine uses the following ICRs:

 ;  #4984 - File 8932.1, Field 90002   (private)

 ;

 Q

 ;

 ; Make PDMP Web Service call

EN(ORRETURN,DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 ;

 ; Returns:

 ;   @ORRETURN@(0) = Status ^ Flag if data shared (1/0) ^ VDIF Session ID

 ;          Note: Status can be one of the following values:

 ;                 1 - success

 ;                -1 - PDMP down, or other reason that didn't even attempt to connect

 ;                -2 - error connecting

 ;                -3 - connected - but error returned by PDMP

 ;   @ORRETURN@(1) = If success: Report URL; If error: error message

 ;

 ; If error: error message to display to the user

 ;   @ORRETURN@("ERR") = If errors, more details about the error

 ;

 N $ES,$ET,ORDATASHARED

 ;

 S ORRETURN=$NA(^TMP("ORPDMP",$J))

 K ^TMP("ORPDMP",$J)

 ;

 S $ET="D ERRHNDL^ORPDMPWS"

 ;

 ; Patient Request

 D REQUEST(DFN,ORUSER,ORDELEGATEOF,ORINST)

 ;

 Q

 ;

 ;

ERRHNDL ;

 ;

 ; ZEXCEPT: XOBERR,ORDATASHARED

 N %ZT

 ;

 K ^TMP("ORPDMP",$J)

 S ^TMP("ORPDMP",$J,0)="-3^"_+$G(ORDATASHARED)

 S ^TMP("ORPDMP",$J,1)="VistA (M) error encountered. Log a ticket, so support can check the error trap for more info."

 S ^TMP("ORPDMP",$J,"ERR",1)=$G(^TMP("ORPDMP",$J,1))

 ;

 I $G(XOBERR)="" S XOBERR=$$EOFAC^XOBWLIB()

 S %ZT("^TMP(""ORPDMPIN"",$J)")=""

 S %ZT("^TMP(""ORPDMP"",$J)")=""

 D ZTER^XOBWLIB(XOBERR)

 D UNWIND^%ZTER

 ;

 Q

 ;

 ; Initiate PDMP REST request

REQUEST(DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 ;

 ; ZEXCEPT: ORDATASHARED

 N ORERR,ORI,OROPENTIMEOUT,ORRESOURCE,ORRESTREQ,ORRET,ORSERVER,ORXML

 ;

 S ORSERVER="PDMP SERVER"

 I '$$PROD^XUPROD S ORSERVER="PDMP TEST SERVER"

 S ORRESTREQ=$$GETREST^XOBWLIB("PDMP WEB SERVICE",ORSERVER)

 ;

 S ORRESTREQ.ContentType="application/xml"

 D REQUESTXML(.ORXML,DFN,ORUSER,ORDELEGATEOF,ORINST)

 S ORI=0

 F  S ORI=$O(ORXML(ORI)) Q:'ORI  D

 . D ORRESTREQ.EntityBody.Write($G(ORXML(ORI)))

 ;

 S ORRESOURCE="/PDMP/patient"

 S OROPENTIMEOUT=+$$GET^XPAR("ALL","OR PDMP OPEN TIMEOUT",1,"I")

 I OROPENTIMEOUT'>0 S OROPENTIMEOUT=10

 S ORRESTREQ.OpenTimeout=OROPENTIMEOUT

 S ORRET=$$POST^XOBWLIB(ORRESTREQ,ORRESOURCE,.ORERR,0)

 S ORDATASHARED=1  ; Flag so that we know we might have shared patient's data. Used by ERRHNDL in case M error encountered.

 ;

 K ^TMP("ORPDMPIN",$J)

 D PROCRESPONSE(ORRET,ORRESTREQ,.ORERR)

 K ^TMP("ORPDMPIN",$J)

 ;

 Q

 ;

 ; Process response from server

PROCRESPONSE(ORRET,ORRESTREQ,ORERR) ;

 ;

 N ORERRARR,ORERRCODE,ORERRDETAILS,ORERRMSG,ORERRORIGIN,ORHTTPSTAT,ORI,ORJ,ORLENGTH,ORLN

 N ORREPORT,ORRESPONSE,ORRESULTS,ORSHARED,ORSESSION,ORTXT

 ;

 S ORRESPONSE=ORRESTREQ.HttpResponse

 S ORHTTPSTAT=""

 I $G(ORRESPONSE)'="" S ORHTTPSTAT=ORRESPONSE.StatusCode

 ;

 ; Error occurred making web service call

 I 'ORRET!(ORHTTPSTAT'=200) D  Q

 . D ERR2ARR^XOBWLIB(.ORERR,.ORERRARR)

 . S ORERRMSG=""

 . S ORSHARED=0

 . S ORERRCODE=-2

 . ;

 . ;code: 6059 - Unable to open TCP/IP socket to server

 . I $G(ORERRARR("code"))=6059 D

 . . S ORERRMSG="Error connecting to PDMP server."

 . ;code: 6085 - Unable to write to socket with SSL/TLS configuration (when conf doesn't exist or is not supported by server)

 . I $G(ORERRARR("code"))=6085 D

 . . S ORERRMSG="Error connecting to PDMP server. Problem with SSL/TLS configuration."

 . ;code: 5922 - Timed out waiting for response

 . I $G(ORERRARR("code"))=5922 D

 . . S ORSHARED=1

 . . S ORERRMSG="Timed out waiting for response from PDMP server."

 . ;HTTP Status Code = 404 - if couldn't authenticate (Normally 401 is used for this; but this is what they return)

 . I ORHTTPSTAT=404 D

 . . S ORERRMSG="Error connecting to PDMP server. Problem authenticating."

 . ;HTTP Status Code = 500 - or other errors

 . I ORERRMSG="" D

 . . S ORERRCODE=-3

 . . S ORERRMSG="Unexpected error returned by PDMP middleware when processing the PDMP request."

 . ;

 . S ^TMP("ORPDMP",$J,0)=ORERRCODE_U_ORSHARED

 . S ^TMP("ORPDMP",$J,1)=ORERRMSG

 . ; Return more error info in ERR node

 . S ^TMP("ORPDMP",$J,"ERR",1)=$G(^TMP("ORPDMP",$J,1))

 . S ORLN=1

 . S ORI=""

 . F  S ORI=$O(ORERRARR(ORI)) Q:ORI=""  D

 . . S ORTXT=$G(ORERRARR(ORI))

 . . I ORTXT'="" D

 . . . S ORLN=ORLN+1

 . . . S ^TMP("ORPDMP",$J,"ERR",ORLN)=ORI_": "_ORTXT

 . . S ORJ=""

 . . F  S ORJ=$O(ORERRARR(ORI,ORJ)) Q:ORJ=""  D

 . . . S ORTXT=$G(ORERRARR(ORI,ORJ))

 . . . I ORTXT'="" D

 . . . . S ORLN=ORLN+1

 . . . . S ^TMP("ORPDMP",$J,"ERR",ORLN)=ORI_": "_ORTXT

 . S ORLN=ORLN+1

 . S ^TMP("ORPDMP",$J,"ERR",ORLN)="HTTP Status Code: "_ORHTTPSTAT

 ;

 ; Success (200) - read in response

 S ORI=0

 S ORLENGTH=245

 F  Q:ORRESPONSE.Data.AtEnd  D

 . S ORI=ORI+1

 . S ^TMP("ORPDMPIN",$J,ORI)=ORRESPONSE.Data.Read(ORLENGTH)

 ;

 D PARSEXML(.ORRESULTS,$NA(^TMP("ORPDMPIN",$J)))

 S ORSHARED=$G(ORRESULTS("DataDisclosed"))

 S ORSHARED=$S(ORSHARED="yes":1,1:0)

 S ORREPORT=$G(ORRESULTS("ReportLink"))

 S ORERRCODE=$G(ORRESULTS("Code"))

 S ORERRMSG=$G(ORRESULTS("Message"))

 S ORERRDETAILS=$G(ORRESULTS("Details"))

 S ORERRORIGIN=$G(ORRESULTS("Origin"))

 S ORSESSION=$G(ORRESULTS("Session"))

 ;

 ; Report URL returned - Success

 I ORREPORT'="" D  Q

 . S ^TMP("ORPDMP",$J,0)=1_U_ORSHARED_U_ORSESSION

 . S ^TMP("ORPDMP",$J,1)=ORREPORT

 ;

 ; Error returned by server in response XML message

 I ORERRMSG'="" D  Q

 . S ^TMP("ORPDMP",$J,0)=-3_U_ORSHARED_U_ORSESSION

 . S ^TMP("ORPDMP",$J,1)=ORERRMSG

 . S ^TMP("ORPDMP",$J,"ERR",1)="Code: "_ORERRCODE

 . S ^TMP("ORPDMP",$J,"ERR",2)="Message: "_ORERRMSG

 . S ^TMP("ORPDMP",$J,"ERR",3)="Origin: "_ORERRORIGIN

 . S ^TMP("ORPDMP",$J,"ERR",4)="Details: "_ORERRDETAILS

 ;

 ; If Report URL is null and ErrorMsg is null, then something is wrong. Perhaps error parsing xml

 I $G(ORRESULTS("DataDisclosed"))="" S ORSHARED=1

 S ^TMP("ORPDMP",$J,0)=-3_U_ORSHARED_U_ORSESSION

 S ^TMP("ORPDMP",$J,1)="Error processing PDMP results."

 S ^TMP("ORPDMP",$J,"ERR",1)=$G(^TMP("ORPDMP",$J,1))

 S ^TMP("ORPDMP",$J,"ERR",2)="XML:"

 S ORI=2

 S ORJ=0

 F  S ORJ=$O(^TMP("ORPDMPIN",$J,ORJ)) Q:'ORJ  D

 . S ORI=ORI+1

 . S ^TMP("ORPDMP",$J,"ERR",ORI)=$G(^TMP("ORPDMPIN",$J,ORJ))

 ;

 Q

 ;

 ; Return XML to send in REST query

REQUESTXML(ORXML,DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 ;

 N ORADDRESS,ORCELL,OREMAIL,ORICN,ORINSTINFO,ORLINE,ORNAME,ORPERSCLASS,ORPROV,ORTEMPADD,ORTEMPPHONE

 N VADM,VAPA,VAPTYP,VAROOT,VATEST,VAHOW

 ;

 S ORUSER=$G(ORUSER,DUZ)

 S ORDELEGATEOF=$G(ORDELEGATEOF)

 S ORINST=$G(ORINST,DUZ(2))

 I ORINST="" S ORINST=$$KSP^XUPARAM("INST")

 ;

 S ORLINE=0

 ;

 S ORXML($$INCLINE)="<PatientReportRequest>"

 ;

 S ORXML($$INCLINE)="<Provider>"

 S ORPROV=ORUSER

 I $G(ORDELEGATEOF) S ORPROV=ORDELEGATEOF

 S ORPERSCLASS=$$PERSCLASS(ORPROV)

 S ORXML($$INCLINE)="<X12Code>"_$$SYMENC^MXMLUTL($P(ORPERSCLASS,U,2))_"</X12Code>"

 S ORXML($$INCLINE)="<VACode>"_$$SYMENC^MXMLUTL($P(ORPERSCLASS,U,1))_"</VACode>"

 S ORNAME=$$GET1^DIQ(200,ORPROV_",",.01)  ; ICR 10060 (supported)

 D NAMECOMP^XLFNAME(.ORNAME)

 S ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 S ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 S ORXML($$INCLINE)="<DEANumber>"_$$SYMENC^MXMLUTL($$USERDEA^ORPDMP(ORPROV))_"</DEANumber>"

 S ORXML($$INCLINE)="<NPINumber>"_$$SYMENC^MXMLUTL($$USERNPI^ORPDMP(ORPROV))_"</NPINumber>"

 S ORXML($$INCLINE)="</Provider>"

 ;

 I ORDELEGATEOF D

 . S ORPERSCLASS=$$PERSCLASS(ORUSER)

 . S ORXML($$INCLINE)="<Delegate>"

 . S ORXML($$INCLINE)="<X12Code>"_$$SYMENC^MXMLUTL($P(ORPERSCLASS,U,2))_"</X12Code>"

 . S ORXML($$INCLINE)="<VACode>"_$$SYMENC^MXMLUTL($P(ORPERSCLASS,U,1))_"</VACode>"

 . K ORNAME

 . S ORNAME=$$GET1^DIQ(200,ORUSER_",",.01)  ; ICR 10060 (supported)

 . D NAMECOMP^XLFNAME(.ORNAME)

 . S ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 . S ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 . D GETEMAIL^ORPDMP(.OREMAIL,ORUSER)

 . S ORXML($$INCLINE)="<SystemID>"_$$SYMENC^MXMLUTL(OREMAIL)_"</SystemID>"

 . S ORXML($$INCLINE)="</Delegate>"

 ;

 S ORXML($$INCLINE)="<UserLocation>"

 S ORXML($$INCLINE)="<Name>"_$$SYMENC^MXMLUTL($$NAME^XUAF4(ORINST))_"</Name>"

 S ORINSTINFO=$$INSTINFO(ORINST)

 S ORXML($$INCLINE)="<DEANumber>"_$$SYMENC^MXMLUTL($P(ORINSTINFO,U,1))_"</DEANumber>"

 S ORXML($$INCLINE)="<NPINumber>"_$$SYMENC^MXMLUTL($P(ORINSTINFO,U,2))_"</NPINumber>"

 S ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($P($$PADD^XUAF4(ORINST),U,3))_"</StateCode>"

 S ORXML($$INCLINE)="</UserLocation>"

 ;

 S ORXML($$INCLINE)="<Patient>"

 D DEM^VADPT

 K ORNAME

 S ORNAME=$G(VADM(1))

 D NAMECOMP^XLFNAME(.ORNAME)

 S ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 S ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 S ORXML($$INCLINE)="<MiddleName>"_$$SYMENC^MXMLUTL(ORNAME("MIDDLE"))_"</MiddleName>"

 S ORXML($$INCLINE)="<DOB>"_$$SYMENC^MXMLUTL($TR($$FMTE^XLFDT(+$G(VADM(3)),"7DZ"),"/","-"))_"</DOB>"

 S ORXML($$INCLINE)="<GenderCode>"_$$SYMENC^MXMLUTL($P($G(VADM(5)),U,1))_"</GenderCode>"

 S ORXML($$INCLINE)="<DFN>"_DFN_"</DFN>"

 S ORXML($$INCLINE)="<StationCode>"_$$SYMENC^MXMLUTL($$STA^XUAF4($$KSP^XUPARAM("INST")))_"</StationCode>"

 S ORICN=$$GETICN^MPIF001(DFN)

 I ORICN<0 S ORICN=""

 S ORXML($$INCLINE)="<ICN>"_$$SYMENC^MXMLUTL(ORICN)_"</ICN>"

 ;

 S ORXML($$INCLINE)="<Addresses>"

 ;

 D ADD^VADPT

 S ORTEMPADD=$S($G(VAPA(9))'="":1,1:0)

 ;

 S ORXML($$INCLINE)="<Address>"

 S ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($G(VAPA(1)))_"</Street>"

 S ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($G(VAPA(4)))_"</City>"

 S ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$G(VAPA(5))_",",1,"I"))_"</StateCode>"

 S ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($G(VAPA(6)))_"</ZipCode>"

 S ORXML($$INCLINE)="<TypeCode>"_$S(ORTEMPADD:"Temporary",1:"Permanent")_"</TypeCode>"

 S ORXML($$INCLINE)="</Address>"

 ;

 ; Residential

 I $G(VAPA(30))'=""!($G(VAPA(33))'="")!($G(VAPA(34))'="")!($G(VAPA(35))'="") D

 . S ORXML($$INCLINE)="<Address>"

 . S ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($G(VAPA(30)))_"</Street>"

 . S ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($G(VAPA(33)))_"</City>"

 . S ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$G(VAPA(34))_",",1,"I"))_"</StateCode>"

 . S ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($G(VAPA(35)))_"</ZipCode>"

 . S ORXML($$INCLINE)="<TypeCode>Residential</TypeCode>"

 . S ORXML($$INCLINE)="</Address>"

 ;

 ; when temp is active, also return permanent address

 I ORTEMPADD D

 . S ORTEMPPHONE=$G(VAPA(8))

 . K VAPA

 . S VAPA("P")=1

 . D ADD^VADPT

 . S ORXML($$INCLINE)="<Address>"

 . S ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($G(VAPA(1)))_"</Street>"

 . S ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($G(VAPA(4)))_"</City>"

 . S ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$G(VAPA(5))_",",1,"I"))_"</StateCode>"

 . S ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($G(VAPA(6)))_"</ZipCode>"

 . S ORXML($$INCLINE)="<TypeCode>Permanent</TypeCode>"

 . S ORXML($$INCLINE)="</Address>"

 ;

 S ORXML($$INCLINE)="</Addresses>"

 ;

 S ORXML($$INCLINE)="<Phones>"

 ;

 S ORXML($$INCLINE)="<Phone>"

 S ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL($G(VAPA(8)))_"</Number>"

 S ORXML($$INCLINE)="<TypeCode>Residence</TypeCode>"

 S ORXML($$INCLINE)="</Phone>"

 ;

 I $G(ORTEMPPHONE)'="" D

 . S ORXML($$INCLINE)="<Phone>"

 . S ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL(ORTEMPPHONE)_"</Number>"

 . S ORXML($$INCLINE)="<TypeCode>Temporary</TypeCode>"

 . S ORXML($$INCLINE)="</Phone>"

 ;

 S ORCELL=$$GET1^DIQ(2,DFN_",",.134)

 I ORCELL'="" D

 . S ORXML($$INCLINE)="<Phone>"

 . S ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL(ORCELL)_"</Number>"

 . S ORXML($$INCLINE)="<TypeCode>Cellular</TypeCode>"

 . S ORXML($$INCLINE)="</Phone>"

 ;

 S ORXML($$INCLINE)="</Phones>"

 S ORXML($$INCLINE)="</Patient>"

 S ORXML($$INCLINE)="</PatientReportRequest>"

 ;

 Q

 ;

 ;

INCLINE() ;

 ; ZEXCEPT: ORLINE

 S ORLINE=ORLINE+1

 Q ORLINE

 ;

 ; Get user's Person Class Info

PERSCLASS(ORUSER) ;

 ;

 N ORPERSCLASS,ORPERSCLASS0,ORRET

 ;

 S ORRET=""

 S ORPERSCLASS=$$GET^XUA4A72(ORUSER)

 S ORPERSCLASS0=""

 I ORPERSCLASS>0 D

 . S ORPERSCLASS0=$$IEN2DATA^XUA4A72(ORPERSCLASS)

 . I $P(ORPERSCLASS0,U,4)="i" S ORPERSCLASS0="" Q  ; Inactive

 . I $$GET1^DIQ(8932.1,+ORPERSCLASS_",",90002,"I")="N" S ORPERSCLASS0=""  ; Non-Individual - ICR 4984

 Q $P(ORPERSCLASS0,U,6,7)

 ;

 ; Return Intitution DEA # and NPI #

INSTINFO(ORINST) ;

 ;

 N ORARR,ORDEA,ORNPI

 ;

 S ORDEA=$$INSTDEA^ORPDMP(ORINST)

 I ORDEA'="" Q ORDEA

 S ORNPI=$$NPI^XUSNPI("Organization_ID",ORINST)

 I $P(ORNPI,U,1)=""!($P(ORNPI,U,3)'="Active") S ORNPI=""

 ;

 I ORDEA'=""!(ORNPI'="") Q ORDEA_U_$P(ORNPI,U,1)

 ;

 ; if child does not have DEA and NPI set, look at parent

 D PARENT^XUAF4("ORARR","`"_ORINST,"PARENT FACILITY")

 S ORINST=$O(ORARR("P",""))

 I 'ORINST Q ""

 ;

 S ORDEA=$$INSTDEA^ORPDMP(ORINST)

 I ORDEA'="" Q ORDEA

 S ORNPI=$$NPI^XUSNPI("Organization_ID",ORINST)

 I $P(ORNPI,U,1)=""!($P(ORNPI,U,3)'="Active") S ORNPI=""

 ;

 Q ORDEA_U_$P(ORNPI,U,1)

 ;

 ; Parse XML to array

PARSEXML(ORRESULT,ORXML) ;

 N ORCALLBACK,ORELEMENT

 S ORCALLBACK("STARTELEMENT")="STARTEL^ORPDMPWS"

 S ORCALLBACK("CHARACTERS")="CHARS^ORPDMPWS"

 D EN^MXMLPRSE(ORXML,.ORCALLBACK,"W")

 Q

 ;

 ;

STARTEL(ORNAME,ORATTRLIST) ;

 ; ZEXCEPT: ORELEMENT

 S ORELEMENT=ORNAME

 Q

 ;

 ;

CHARS(ORTEXT) ;

 ; ZEXCEPT: ORRESULT,ORELEMENT

 I ORTEXT?.C Q

 I ORTEXT?." " Q

 I $G(ORELEMENT)="" Q

 S ORRESULT(ORELEMENT)=$G(ORRESULT(ORELEMENT))_ORTEXT

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORPDMPWS   13882     printed  Feb 18, 2025@23:59:02                                                                                                                                                                                                   Page 2

ORPDMPWS  ;ISP/LMT - PDMP Web Service APIs ;Nov 04, 2020@14:19:06

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,498**;Dec 17, 1997;Build 38

 +2       ;

 +3       ; SAC EXEMPTION 20200131-02 : non-ANSI standard M code

 +4       ;

 +5       ; This routine uses the following ICRs:

 +6       ;  #4984 - File 8932.1, Field 90002   (private)

 +7       ;

 +8        QUIT 

 +9       ;

 +10      ; Make PDMP Web Service call

EN(ORRETURN,DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 +1       ;

 +2       ; Returns:

 +3       ;   @ORRETURN@(0) = Status ^ Flag if data shared (1/0) ^ VDIF Session ID

 +4       ;          Note: Status can be one of the following values:

 +5       ;                 1 - success

 +6       ;                -1 - PDMP down, or other reason that didn't even attempt to connect

 +7       ;                -2 - error connecting

 +8       ;                -3 - connected - but error returned by PDMP

 +9       ;   @ORRETURN@(1) = If success: Report URL; If error: error message

 +10      ;

 +11      ; If error: error message to display to the user

 +12      ;   @ORRETURN@("ERR") = If errors, more details about the error

 +13      ;

 +14       NEW $ESTACK,$ETRAP,ORDATASHARED

 +15      ;

 +16       SET ORRETURN=$NAME(^TMP("ORPDMP",$JOB))

 +17       KILL ^TMP("ORPDMP",$JOB)

 +18      ;

 +19       SET $ETRAP="D ERRHNDL^ORPDMPWS"

 +20      ;

 +21      ; Patient Request

 +22       DO REQUEST(DFN,ORUSER,ORDELEGATEOF,ORINST)

 +23      ;

 +24       QUIT 

 +25      ;

 +26      ;

ERRHNDL   ;

 +1       ;

 +2       ; ZEXCEPT: XOBERR,ORDATASHARED

 +3        NEW %ZT

 +4       ;

 +5        KILL ^TMP("ORPDMP",$JOB)

 +6        SET ^TMP("ORPDMP",$JOB,0)="-3^"_+$GET(ORDATASHARED)

 +7        SET ^TMP("ORPDMP",$JOB,1)="VistA (M) error encountered. Log a ticket, so support can check the error trap for more info."

 +8        SET ^TMP("ORPDMP",$JOB,"ERR",1)=$GET(^TMP("ORPDMP",$JOB,1))

 +9       ;

 +10       IF $GET(XOBERR)=""

               SET XOBERR=$$EOFAC^XOBWLIB()

 +11       SET %ZT("^TMP(""ORPDMPIN"",$J)")=""

 +12       SET %ZT("^TMP(""ORPDMP"",$J)")=""

 +13       DO ZTER^XOBWLIB(XOBERR)

 +14       DO UNWIND^%ZTER

 +15      ;

 +16       QUIT 

 +17      ;

 +18      ; Initiate PDMP REST request

REQUEST(DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 +1       ;

 +2       ; ZEXCEPT: ORDATASHARED

 +3        NEW ORERR,ORI,OROPENTIMEOUT,ORRESOURCE,ORRESTREQ,ORRET,ORSERVER,ORXML

 +4       ;

 +5        SET ORSERVER="PDMP SERVER"

 +6        IF '$$PROD^XUPROD

               SET ORSERVER="PDMP TEST SERVER"

 +7        SET ORRESTREQ=$$GETREST^XOBWLIB("PDMP WEB SERVICE",ORSERVER)

 +8       ;

 +9        SET ORRESTREQ.ContentType="application/xml"

 +10       DO REQUESTXML(.ORXML,DFN,ORUSER,ORDELEGATEOF,ORINST)

 +11       SET ORI=0

 +12       FOR 

               SET ORI=$ORDER(ORXML(ORI))

               if 'ORI

                   QUIT 

               Begin DoDot:1

 +13               DO ORRESTREQ.EntityBody.Write($GET(ORXML(ORI)))

               End DoDot:1

 +14      ;

 +15       SET ORRESOURCE="/PDMP/patient"

 +16       SET OROPENTIMEOUT=+$$GET^XPAR("ALL","OR PDMP OPEN TIMEOUT",1,"I")

 +17       IF OROPENTIMEOUT'>0

               SET OROPENTIMEOUT=10

 +18       SET ORRESTREQ.OpenTimeout=OROPENTIMEOUT

 +19       SET ORRET=$$POST^XOBWLIB(ORRESTREQ,ORRESOURCE,.ORERR,0)

 +20      ; Flag so that we know we might have shared patient's data. Used by ERRHNDL in case M error encountered.

           SET ORDATASHARED=1

 +21      ;

 +22       KILL ^TMP("ORPDMPIN",$JOB)

 +23       DO PROCRESPONSE(ORRET,ORRESTREQ,.ORERR)

 +24       KILL ^TMP("ORPDMPIN",$JOB)

 +25      ;

 +26       QUIT 

 +27      ;

 +28      ; Process response from server

PROCRESPONSE(ORRET,ORRESTREQ,ORERR) ;

 +1       ;

 +2        NEW ORERRARR,ORERRCODE,ORERRDETAILS,ORERRMSG,ORERRORIGIN,ORHTTPSTAT,ORI,ORJ,ORLENGTH,ORLN

 +3        NEW ORREPORT,ORRESPONSE,ORRESULTS,ORSHARED,ORSESSION,ORTXT

 +4       ;

 +5        SET ORRESPONSE=ORRESTREQ.HttpResponse

 +6        SET ORHTTPSTAT=""

 +7        IF $GET(ORRESPONSE)'=""

               SET ORHTTPSTAT=ORRESPONSE.StatusCode

 +8       ;

 +9       ; Error occurred making web service call

 +10       IF 'ORRET!(ORHTTPSTAT'=200)

               Begin DoDot:1

 +11               DO ERR2ARR^XOBWLIB(.ORERR,.ORERRARR)

 +12               SET ORERRMSG=""

 +13               SET ORSHARED=0

 +14               SET ORERRCODE=-2

 +15      ;

 +16      ;code: 6059 - Unable to open TCP/IP socket to server

 +17               IF $GET(ORERRARR("code"))=6059

                       Begin DoDot:2

 +18                       SET ORERRMSG="Error connecting to PDMP server."

                       End DoDot:2

 +19      ;code: 6085 - Unable to write to socket with SSL/TLS configuration (when conf doesn't exist or is not supported by server)

 +20               IF $GET(ORERRARR("code"))=6085

                       Begin DoDot:2

 +21                       SET ORERRMSG="Error connecting to PDMP server. Problem with SSL/TLS configuration."

                       End DoDot:2

 +22      ;code: 5922 - Timed out waiting for response

 +23               IF $GET(ORERRARR("code"))=5922

                       Begin DoDot:2

 +24                       SET ORSHARED=1

 +25                       SET ORERRMSG="Timed out waiting for response from PDMP server."

                       End DoDot:2

 +26      ;HTTP Status Code = 404 - if couldn't authenticate (Normally 401 is used for this; but this is what they return)

 +27               IF ORHTTPSTAT=404

                       Begin DoDot:2

 +28                       SET ORERRMSG="Error connecting to PDMP server. Problem authenticating."

                       End DoDot:2

 +29      ;HTTP Status Code = 500 - or other errors

 +30               IF ORERRMSG=""

                       Begin DoDot:2

 +31                       SET ORERRCODE=-3

 +32                       SET ORERRMSG="Unexpected error returned by PDMP middleware when processing the PDMP request."

                       End DoDot:2

 +33      ;

 +34               SET ^TMP("ORPDMP",$JOB,0)=ORERRCODE_U_ORSHARED

 +35               SET ^TMP("ORPDMP",$JOB,1)=ORERRMSG

 +36      ; Return more error info in ERR node

 +37               SET ^TMP("ORPDMP",$JOB,"ERR",1)=$GET(^TMP("ORPDMP",$JOB,1))

 +38               SET ORLN=1

 +39               SET ORI=""

 +40               FOR 

                       SET ORI=$ORDER(ORERRARR(ORI))

                       if ORI=""

                           QUIT 

                       Begin DoDot:2

 +41                       SET ORTXT=$GET(ORERRARR(ORI))

 +42                       IF ORTXT'=""

                               Begin DoDot:3

 +43                               SET ORLN=ORLN+1

 +44                               SET ^TMP("ORPDMP",$JOB,"ERR",ORLN)=ORI_": "_ORTXT

                               End DoDot:3

 +45                       SET ORJ=""

 +46                       FOR 

                               SET ORJ=$ORDER(ORERRARR(ORI,ORJ))

                               if ORJ=""

                                   QUIT 

                               Begin DoDot:3

 +47                               SET ORTXT=$GET(ORERRARR(ORI,ORJ))

 +48                               IF ORTXT'=""

                                       Begin DoDot:4

 +49                                       SET ORLN=ORLN+1

 +50                                       SET ^TMP("ORPDMP",$JOB,"ERR",ORLN)=ORI_": "_ORTXT

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +51               SET ORLN=ORLN+1

 +52               SET ^TMP("ORPDMP",$JOB,"ERR",ORLN)="HTTP Status Code: "_ORHTTPSTAT

               End DoDot:1

               QUIT 

 +53      ;

 +54      ; Success (200) - read in response

 +55       SET ORI=0

 +56       SET ORLENGTH=245

 +57       FOR 

               if ORRESPONSE.Data.AtEnd

                   QUIT 

               Begin DoDot:1

 +58               SET ORI=ORI+1

 +59               SET ^TMP("ORPDMPIN",$JOB,ORI)=ORRESPONSE.Data.Read(ORLENGTH)

               End DoDot:1

 +60      ;

 +61       DO PARSEXML(.ORRESULTS,$NAME(^TMP("ORPDMPIN",$JOB)))

 +62       SET ORSHARED=$GET(ORRESULTS("DataDisclosed"))

 +63       SET ORSHARED=$SELECT(ORSHARED="yes":1,1:0)

 +64       SET ORREPORT=$GET(ORRESULTS("ReportLink"))

 +65       SET ORERRCODE=$GET(ORRESULTS("Code"))

 +66       SET ORERRMSG=$GET(ORRESULTS("Message"))

 +67       SET ORERRDETAILS=$GET(ORRESULTS("Details"))

 +68       SET ORERRORIGIN=$GET(ORRESULTS("Origin"))

 +69       SET ORSESSION=$GET(ORRESULTS("Session"))

 +70      ;

 +71      ; Report URL returned - Success

 +72       IF ORREPORT'=""

               Begin DoDot:1

 +73               SET ^TMP("ORPDMP",$JOB,0)=1_U_ORSHARED_U_ORSESSION

 +74               SET ^TMP("ORPDMP",$JOB,1)=ORREPORT

               End DoDot:1

               QUIT 

 +75      ;

 +76      ; Error returned by server in response XML message

 +77       IF ORERRMSG'=""

               Begin DoDot:1

 +78               SET ^TMP("ORPDMP",$JOB,0)=-3_U_ORSHARED_U_ORSESSION

 +79               SET ^TMP("ORPDMP",$JOB,1)=ORERRMSG

 +80               SET ^TMP("ORPDMP",$JOB,"ERR",1)="Code: "_ORERRCODE

 +81               SET ^TMP("ORPDMP",$JOB,"ERR",2)="Message: "_ORERRMSG

 +82               SET ^TMP("ORPDMP",$JOB,"ERR",3)="Origin: "_ORERRORIGIN

 +83               SET ^TMP("ORPDMP",$JOB,"ERR",4)="Details: "_ORERRDETAILS

               End DoDot:1

               QUIT 

 +84      ;

 +85      ; If Report URL is null and ErrorMsg is null, then something is wrong. Perhaps error parsing xml

 +86       IF $GET(ORRESULTS("DataDisclosed"))=""

               SET ORSHARED=1

 +87       SET ^TMP("ORPDMP",$JOB,0)=-3_U_ORSHARED_U_ORSESSION

 +88       SET ^TMP("ORPDMP",$JOB,1)="Error processing PDMP results."

 +89       SET ^TMP("ORPDMP",$JOB,"ERR",1)=$GET(^TMP("ORPDMP",$JOB,1))

 +90       SET ^TMP("ORPDMP",$JOB,"ERR",2)="XML:"

 +91       SET ORI=2

 +92       SET ORJ=0

 +93       FOR 

               SET ORJ=$ORDER(^TMP("ORPDMPIN",$JOB,ORJ))

               if 'ORJ

                   QUIT 

               Begin DoDot:1

 +94               SET ORI=ORI+1

 +95               SET ^TMP("ORPDMP",$JOB,"ERR",ORI)=$GET(^TMP("ORPDMPIN",$JOB,ORJ))

               End DoDot:1

 +96      ;

 +97       QUIT 

 +98      ;

 +99      ; Return XML to send in REST query

REQUESTXML(ORXML,DFN,ORUSER,ORDELEGATEOF,ORINST) ;

 +1       ;

 +2        NEW ORADDRESS,ORCELL,OREMAIL,ORICN,ORINSTINFO,ORLINE,ORNAME,ORPERSCLASS,ORPROV,ORTEMPADD,ORTEMPPHONE

 +3        NEW VADM,VAPA,VAPTYP,VAROOT,VATEST,VAHOW

 +4       ;

 +5        SET ORUSER=$GET(ORUSER,DUZ)

 +6        SET ORDELEGATEOF=$GET(ORDELEGATEOF)

 +7        SET ORINST=$GET(ORINST,DUZ(2))

 +8        IF ORINST=""

               SET ORINST=$$KSP^XUPARAM("INST")

 +9       ;

 +10       SET ORLINE=0

 +11      ;

 +12       SET ORXML($$INCLINE)="<PatientReportRequest>"

 +13      ;

 +14       SET ORXML($$INCLINE)="<Provider>"

 +15       SET ORPROV=ORUSER

 +16       IF $GET(ORDELEGATEOF)

               SET ORPROV=ORDELEGATEOF

 +17       SET ORPERSCLASS=$$PERSCLASS(ORPROV)

 +18       SET ORXML($$INCLINE)="<X12Code>"_$$SYMENC^MXMLUTL($PIECE(ORPERSCLASS,U,2))_"</X12Code>"

 +19       SET ORXML($$INCLINE)="<VACode>"_$$SYMENC^MXMLUTL($PIECE(ORPERSCLASS,U,1))_"</VACode>"

 +20      ; ICR 10060 (supported)

           SET ORNAME=$$GET1^DIQ(200,ORPROV_",",.01)

 +21       DO NAMECOMP^XLFNAME(.ORNAME)

 +22       SET ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 +23       SET ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 +24       SET ORXML($$INCLINE)="<DEANumber>"_$$SYMENC^MXMLUTL($$USERDEA^ORPDMP(ORPROV))_"</DEANumber>"

 +25       SET ORXML($$INCLINE)="<NPINumber>"_$$SYMENC^MXMLUTL($$USERNPI^ORPDMP(ORPROV))_"</NPINumber>"

 +26       SET ORXML($$INCLINE)="</Provider>"

 +27      ;

 +28       IF ORDELEGATEOF

               Begin DoDot:1

 +29               SET ORPERSCLASS=$$PERSCLASS(ORUSER)

 +30               SET ORXML($$INCLINE)="<Delegate>"

 +31               SET ORXML($$INCLINE)="<X12Code>"_$$SYMENC^MXMLUTL($PIECE(ORPERSCLASS,U,2))_"</X12Code>"

 +32               SET ORXML($$INCLINE)="<VACode>"_$$SYMENC^MXMLUTL($PIECE(ORPERSCLASS,U,1))_"</VACode>"

 +33               KILL ORNAME

 +34      ; ICR 10060 (supported)

                   SET ORNAME=$$GET1^DIQ(200,ORUSER_",",.01)

 +35               DO NAMECOMP^XLFNAME(.ORNAME)

 +36               SET ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 +37               SET ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 +38               DO GETEMAIL^ORPDMP(.OREMAIL,ORUSER)

 +39               SET ORXML($$INCLINE)="<SystemID>"_$$SYMENC^MXMLUTL(OREMAIL)_"</SystemID>"

 +40               SET ORXML($$INCLINE)="</Delegate>"

               End DoDot:1

 +41      ;

 +42       SET ORXML($$INCLINE)="<UserLocation>"

 +43       SET ORXML($$INCLINE)="<Name>"_$$SYMENC^MXMLUTL($$NAME^XUAF4(ORINST))_"</Name>"

 +44       SET ORINSTINFO=$$INSTINFO(ORINST)

 +45       SET ORXML($$INCLINE)="<DEANumber>"_$$SYMENC^MXMLUTL($PIECE(ORINSTINFO,U,1))_"</DEANumber>"

 +46       SET ORXML($$INCLINE)="<NPINumber>"_$$SYMENC^MXMLUTL($PIECE(ORINSTINFO,U,2))_"</NPINumber>"

 +47       SET ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($PIECE($$PADD^XUAF4(ORINST),U,3))_"</StateCode>"

 +48       SET ORXML($$INCLINE)="</UserLocation>"

 +49      ;

 +50       SET ORXML($$INCLINE)="<Patient>"

 +51       DO DEM^VADPT

 +52       KILL ORNAME

 +53       SET ORNAME=$GET(VADM(1))

 +54       DO NAMECOMP^XLFNAME(.ORNAME)

 +55       SET ORXML($$INCLINE)="<FirstName>"_$$SYMENC^MXMLUTL(ORNAME("GIVEN"))_"</FirstName>"

 +56       SET ORXML($$INCLINE)="<LastName>"_$$SYMENC^MXMLUTL(ORNAME("FAMILY"))_"</LastName>"

 +57       SET ORXML($$INCLINE)="<MiddleName>"_$$SYMENC^MXMLUTL(ORNAME("MIDDLE"))_"</MiddleName>"

 +58       SET ORXML($$INCLINE)="<DOB>"_$$SYMENC^MXMLUTL($TRANSLATE($$FMTE^XLFDT(+$GET(VADM(3)),"7DZ"),"/","-"))_"</DOB>"

 +59       SET ORXML($$INCLINE)="<GenderCode>"_$$SYMENC^MXMLUTL($PIECE($GET(VADM(5)),U,1))_"</GenderCode>"

 +60       SET ORXML($$INCLINE)="<DFN>"_DFN_"</DFN>"