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 ---[H[J[2J[HORPDMPWS 13882 printed Sep 23, 2025@20:08:49 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>"
+61 SET ORXML($$INCLINE)="<StationCode>"_$$SYMENC^MXMLUTL($$STA^XUAF4($$KSP^XUPARAM("INST")))_"</StationCode>"
+62 SET ORICN=$$GETICN^MPIF001(DFN)
+63 IF ORICN<0
SET ORICN=""
+64 SET ORXML($$INCLINE)="<ICN>"_$$SYMENC^MXMLUTL(ORICN)_"</ICN>"
+65 ;
+66 SET ORXML($$INCLINE)="<Addresses>"
+67 ;
+68 DO ADD^VADPT
+69 SET ORTEMPADD=$SELECT($GET(VAPA(9))'="":1,1:0)
+70 ;
+71 SET ORXML($$INCLINE)="<Address>"
+72 SET ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($GET(VAPA(1)))_"</Street>"
+73 SET ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($GET(VAPA(4)))_"</City>"
+74 SET ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$GET(VAPA(5))_",",1,"I"))_"</StateCode>"
+75 SET ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($GET(VAPA(6)))_"</ZipCode>"
+76 SET ORXML($$INCLINE)="<TypeCode>"_$S(ORTEMPADD:"Temporary",1:"Permanent")_"</TypeCode>"
+77 SET ORXML($$INCLINE)="</Address>"
+78 ;
+79 ; Residential
+80 IF $GET(VAPA(30))'=""!($GET(VAPA(33))'="")!($GET(VAPA(34))'="")!($GET(VAPA(35))'="")
Begin DoDot:1
+81 SET ORXML($$INCLINE)="<Address>"
+82 SET ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($GET(VAPA(30)))_"</Street>"
+83 SET ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($GET(VAPA(33)))_"</City>"
+84 SET ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$GET(VAPA(34))_",",1,"I"))_"</StateCode>"
+85 SET ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($GET(VAPA(35)))_"</ZipCode>"
+86 SET ORXML($$INCLINE)="<TypeCode>Residential</TypeCode>"
+87 SET ORXML($$INCLINE)="</Address>"
End DoDot:1
+88 ;
+89 ; when temp is active, also return permanent address
+90 IF ORTEMPADD
Begin DoDot:1
+91 SET ORTEMPPHONE=$GET(VAPA(8))
+92 KILL VAPA
+93 SET VAPA("P")=1
+94 DO ADD^VADPT
+95 SET ORXML($$INCLINE)="<Address>"
+96 SET ORXML($$INCLINE)="<Street>"_$$SYMENC^MXMLUTL($GET(VAPA(1)))_"</Street>"
+97 SET ORXML($$INCLINE)="<City>"_$$SYMENC^MXMLUTL($GET(VAPA(4)))_"</City>"
+98 SET ORXML($$INCLINE)="<StateCode>"_$$SYMENC^MXMLUTL($$GET1^DIQ(5,+$GET(VAPA(5))_",",1,"I"))_"</StateCode>"
+99 SET ORXML($$INCLINE)="<ZipCode>"_$$SYMENC^MXMLUTL($GET(VAPA(6)))_"</ZipCode>"
+100 SET ORXML($$INCLINE)="<TypeCode>Permanent</TypeCode>"
+101 SET ORXML($$INCLINE)="</Address>"
End DoDot:1
+102 ;
+103 SET ORXML($$INCLINE)="</Addresses>"
+104 ;
+105 SET ORXML($$INCLINE)="<Phones>"
+106 ;
+107 SET ORXML($$INCLINE)="<Phone>"
+108 SET ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL($GET(VAPA(8)))_"</Number>"
+109 SET ORXML($$INCLINE)="<TypeCode>Residence</TypeCode>"
+110 SET ORXML($$INCLINE)="</Phone>"
+111 ;
+112 IF $GET(ORTEMPPHONE)'=""
Begin DoDot:1
+113 SET ORXML($$INCLINE)="<Phone>"
+114 SET ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL(ORTEMPPHONE)_"</Number>"
+115 SET ORXML($$INCLINE)="<TypeCode>Temporary</TypeCode>"
+116 SET ORXML($$INCLINE)="</Phone>"
End DoDot:1
+117 ;
+118 SET ORCELL=$$GET1^DIQ(2,DFN_",",.134)
+119 IF ORCELL'=""
Begin DoDot:1
+120 SET ORXML($$INCLINE)="<Phone>"
+121 SET ORXML($$INCLINE)="<Number>"_$$SYMENC^MXMLUTL(ORCELL)_"</Number>"
+122 SET ORXML($$INCLINE)="<TypeCode>Cellular</TypeCode>"
+123 SET ORXML($$INCLINE)="</Phone>"
End DoDot:1
+124 ;
+125 SET ORXML($$INCLINE)="</Phones>"
+126 SET ORXML($$INCLINE)="</Patient>"
+127 SET ORXML($$INCLINE)="</PatientReportRequest>"
+128 ;
+129 QUIT
+130 ;
+131 ;
INCLINE() ;
+1 ; ZEXCEPT: ORLINE
+2 SET ORLINE=ORLINE+1
+3 QUIT ORLINE
+4 ;
+5 ; Get user's Person Class Info
PERSCLASS(ORUSER) ;
+1 ;
+2 NEW ORPERSCLASS,ORPERSCLASS0,ORRET
+3 ;
+4 SET ORRET=""
+5 SET ORPERSCLASS=$$GET^XUA4A72(ORUSER)
+6 SET ORPERSCLASS0=""
+7 IF ORPERSCLASS>0
Begin DoDot:1
+8 SET ORPERSCLASS0=$$IEN2DATA^XUA4A72(ORPERSCLASS)
+9 ; Inactive
IF $PIECE(ORPERSCLASS0,U,4)="i"
SET ORPERSCLASS0=""
QUIT
+10 ; Non-Individual - ICR 4984
IF $$GET1^DIQ(8932.1,+ORPERSCLASS_",",90002,"I")="N"
SET ORPERSCLASS0=""
End DoDot:1
+11 QUIT $PIECE(ORPERSCLASS0,U,6,7)
+12 ;
+13 ; Return Intitution DEA # and NPI #
INSTINFO(ORINST) ;
+1 ;
+2 NEW ORARR,ORDEA,ORNPI
+3 ;
+4 SET ORDEA=$$INSTDEA^ORPDMP(ORINST)
+5 IF ORDEA'=""
QUIT ORDEA
+6 SET ORNPI=$$NPI^XUSNPI("Organization_ID",ORINST)
+7 IF $PIECE(ORNPI,U,1)=""!($PIECE(ORNPI,U,3)'="Active")
SET ORNPI=""
+8 ;
+9 IF ORDEA'=""!(ORNPI'="")
QUIT ORDEA_U_$PIECE(ORNPI,U,1)
+10 ;
+11 ; if child does not have DEA and NPI set, look at parent
+12 DO PARENT^XUAF4("ORARR","`"_ORINST,"PARENT FACILITY")
+13 SET ORINST=$ORDER(ORARR("P",""))
+14 IF 'ORINST
QUIT ""
+15 ;
+16 SET ORDEA=$$INSTDEA^ORPDMP(ORINST)
+17 IF ORDEA'=""
QUIT ORDEA
+18 SET ORNPI=$$NPI^XUSNPI("Organization_ID",ORINST)
+19 IF $PIECE(ORNPI,U,1)=""!($PIECE(ORNPI,U,3)'="Active")
SET ORNPI=""
+20 ;
+21 QUIT ORDEA_U_$PIECE(ORNPI,U,1)
+22 ;
+23 ; Parse XML to array
PARSEXML(ORRESULT,ORXML) ;
+1 NEW ORCALLBACK,ORELEMENT
+2 SET ORCALLBACK("STARTELEMENT")="STARTEL^ORPDMPWS"
+3 SET ORCALLBACK("CHARACTERS")="CHARS^ORPDMPWS"
+4 DO EN^MXMLPRSE(ORXML,.ORCALLBACK,"W")
+5 QUIT
+6 ;
+7 ;
STARTEL(ORNAME,ORATTRLIST) ;
+1 ; ZEXCEPT: ORELEMENT
+2 SET ORELEMENT=ORNAME
+3 QUIT
+4 ;
+5 ;
CHARS(ORTEXT) ;
+1 ; ZEXCEPT: ORRESULT,ORELEMENT
+2 IF ORTEXT?.C
QUIT
+3 IF ORTEXT?." "
QUIT
+4 IF $GET(ORELEMENT)=""
QUIT
+5 SET ORRESULT(ORELEMENT)=$GET(ORRESULT(ORELEMENT))_ORTEXT
+6 QUIT
+7 ;
