ORRDI1 ;SLC/JMH - RDI ROUTINES FOR API SUPPORTING CDS DATA ;Nov 16, 2022@13:03:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,294,306,269,591,588**;Dec 17, 1997;Build 29
; SAC EXEMPTION 202211140901-03 : Non-standard $Z special variable used
;
GET(DFN,DOMAIN) ;API for packages to call in order to get data from HDR for
I '$L($G(DOMAIN)) S DOMAIN="ART"
; check if in OUTAGE state and quit if so
I $$DOWNXVAL^ORRDI2 D Q -1
.K ^XTMP("ORRDI",DOMAIN,DFN)
.S ^XTMP("ORRDI",DOMAIN,DFN,0)="^^-1"
; order checking purposes
N I,ORCACHE,ORRET,ORRECDT
;check if data was just retrieved a short time ago and if so return
S ORRECDT=$P($G(^XTMP("ORRDI",DOMAIN,DFN,0)),U) I 'ORRECDT S ORRECDT=3000101
S ORCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
I $$FMDIFF^XLFDT($$NOW^XLFDT,ORRECDT,2)<(60*ORCACHE),$P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)>-1 S ORRET=$P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)
;check if there has been an HDR down condition within last minute
I $$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U),2)<60,$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U,3)<0 S ORRET=$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U,3)
I $$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^XTMP("ORRDI","ART",DFN,0)),U),2)<60,$P($G(^XTMP("ORRDI","ART",DFN,0)),U,3)<0 S ORRET=$P($G(^XTMP("ORRDI","ART",DFN,0)),U,3)
;if data is not "fresh" then go get it
I '$L($G(ORRET)) D
.S ORRET=$$RETRIEVE(DFN,DOMAIN)
.I ORRET>-1 S ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=0
.I ORRET'>-1 D
..Q:$P(ORRET,U,2)="PATIENT ICN NOT FOUND"
..I ORRET=-9 S ORRET="-1^PROCESSING ERROR" Q
..S ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=$$FAILXVAL^ORRDI2+1
..I $$FAILXVAL^ORRDI2'<$$FAILPVAL^ORRDI2 D
...S ^XTMP("ORRDI","OUTAGE INFO","DOWN")=1
...D SPAWN^ORRDI2
S $P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3,4)=ORRET
Q ORRET
;
RETRIEVE(DFN,DOMAIN) ;GET DATA
N $ES,$ET
S $ET="D ERRHNDL^ORRDI1(DFN) Q -1"
N Y,ORCSTART,ORPSTART,ORCDIF,ORPDIF,ORALNUM,ORPSNUM,ORREQ,ORXML,ORERR,ORRET,ORY,START,FACIL,ICN
K ^TMP($J,"ORRDI")
S ORY=-1
I '$L($G(DOMAIN)) S DOMAIN="ART"
;GET ICN
S ICN=$$GETICN^MPIF001(DFN)
I +ICN<0 Q -1_"^PATIENT ICN NOT FOUND"
S START=$$FMADD^XLFDT($P($$NOW^XLFDT,"."),-30)
S START=$$FMTHL7^XLFDT(START)
S START=$E(START,1,4)_"-"_$E(START,5,6)_"-"_$E(START,7,8)
S FACIL=$P($$SITE^VASITE,U,3)
;format request XML
S ORREQ="/readClinicalData1?&templateId=RDIAllergiesPharmacyRead40013&"
S ORREQ=ORREQ_"filterRequest=<?xml version=""1.0"" encoding=""UTF-8""?>"
S ORREQ=ORREQ_"<filter:filter vhimVersion=""Vhim_4_00"" xmlns:filter=""Filter"" "
S ORREQ=ORREQ_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
S ORREQ=ORREQ_"<filterId>RDI_ALLERGY_RX_SINGLE_PATIENT_FILTER</filterId>"
S ORREQ=ORREQ_"<clientName>RDI</clientName><patients><NationalId>"_ICN_"</NationalId>"
S ORREQ=ORREQ_"<excludeIdentifiers><assigningAuthority>USVHA</assigningAuthority>"
S ORREQ=ORREQ_"<assigningFacility>"_FACIL_"</assigningFacility></excludeIdentifiers></patients>"
S ORREQ=ORREQ_"<entryPointFilter queryName=""IC-Standardized""><domainEntryPoint>IntoleranceCondition</domainEntryPoint>"
S ORREQ=ORREQ_"<xpathQuery><xpath>intoleranceConditions[((gmrAllergyAgent[(code!='') and (codingSystem = '99"
S ORREQ=ORREQ_"VHA_ERT' or contains(.,'99VA'))]) or (drugClass/code[(code!='') and (codingSystem = '99VHA_ERT' or co"
S ORREQ=ORREQ_"ntains(.,'99VA'))]) or (drugIngredient/code[(code!='') and (codingSystem = '99VHA_ERT' or contain"
S ORREQ=ORREQ_"s(.,'99VA'))])) and (status = 'F')]</xpath></xpathQuery></entryPointFilter>"
S ORREQ=ORREQ_"<entryPointFilter queryName=""OMP-Standardized"">"
S ORREQ=ORREQ_"<domainEntryPoint>OutpatientMedicationPromise</domainEntryPoint>"
S ORREQ=ORREQ_"<startDate>"_START_"</startDate><xpathQuery><xpath>outpatientMedicationPromises[pharmacyRe"
S ORREQ=ORREQ_"quest/orderedMedication/medicationCode[(code!='') and (codingSystem = '99VHA_ERT' or contain"
S ORREQ=ORREQ_"s(.,'99VA'))]]</xpath></xpathQuery></entryPointFilter><entryPointFilter queryName=""AA-Standardized"">"
S ORREQ=ORREQ_"<domainEntryPoint>AllergyAssessment</domainEntryPoint></entryPointFilter></filter:filter>"
S ORCSTART=$ZH
S ORREQ=ORREQ_"&filterId=RDI_ALLERGY_RX_SINGLE_PATIENT_FILTER&requestId="_FACIL_"RDI"_$$NOW^XLFDT_";"_ORCSTART
;make call to HDR
S ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
S ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,0)
S ORCDIF=$ZH-ORCSTART
I ORRET D Q ORY
.;parse out xml into temp global
.S ORPSTART=$ZH
.D PARSE(ORXML.HttpResponse.Data)
.S ORPDIF=$ZH-ORCSTART-ORCDIF
.;move from temp global into ^XTMP("ORRDI" domain globals
.S ORALNUM=$$AL(DFN)
.S ORPSNUM=$$PS(DFN)
.S ^XTMP("ORRDI","ART",DFN,0)=$$NOW^XLFDT_U_U_ORALNUM
.S ^XTMP("ORRDI","PSOO",DFN,0)=$$NOW^XLFDT_U_U_ORPSNUM
.S ^XTMP("ORRDI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
.I DOMAIN="ART" S ORY=ORALNUM
.I DOMAIN="PSOO" S ORY=ORPSNUM
.I +ORY>-1 S ^XTMP("ORRDI","TESTREQ")=ORREQ
.;set metrics for data retrieval and parsing
.S ^XTMP("ORRDI","METRICS",$$NOW^XLFDT,ORCSTART)=DFN_U_ORCDIF_U_ORPDIF_U_ORALNUM_U_ORPSNUM
.K ^TMP($J,"ORRDI")
I 'ORRET!(ORERR) S ^XTMP("ORRDI","METRICS",$$NOW^XLFDT,ORCSTART)=DFN_U_"ERROR" D Q "-1^"_ORERR
.S ^XTMP("ORRDI","ART",DFN,0)=U_U_"-1^"_ORERR
.S ^XTMP("ORRDI","PSOO",DFN,0)=U_U_"-1^"_ORERR
Q -1
;
PS(DFN) ;expects ^TMP($J,"ORRDI")
K ^XTMP("ORRDI","PSOO",DFN)
N ORQ S ORQ=$$MSGERR Q:($L(ORQ)>0) -1_U_ORQ
N I,GL,CNT
S CNT=0,GL=$NA(^TMP($J,"ORRDI","ClinicalData",0,"patient",0,"outpatientMedicationPromises"))
S I="" F S I=$O(@GL@(I)) Q:'$L(I) D
.S CNT=CNT+1
.S ^XTMP("ORRDI","PSOO",DFN,I+1,1,0)=$G(@GL@(I,"pharmacyRequest",0,"orderingInstitutionIdentifier",0,"name",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,2,0)=$G(@GL@(I,"pharmacyRequest",0,"orderedMedication",0,"medicationCode",0,"displayText",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,3,0)=$G(@GL@(I,"pharmacyRequest",0,"orderedMedication",0,"medicationCode",0,"code",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,4,0)=$G(@GL@(I,"prescriptionId",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,5,0)=$G(@GL@(I,"pharmacyRequest",0,"statusModifier",0,"displayText",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,6,0)=$G(@GL@(I,"originalDispense",0,"quantityDispensed",0,"value",0))_";"_$G(@GL@(I,"originalDispense",0,"daysSupply",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,7,0)=$$DTCONV($G(@GL@(I,"expirationDate",0,"literal",0)))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,8,0)=$$DTCONV($G(@GL@(I,"pharmacyRequest",0,"orderDate",0,"literal",0)))
.N K S K="" F S K=$O(@GL@(I,"refillDispense",K)) Q:'$L(K) D
..I $G(@GL@(I,"refillDispense",K,"fillDate",0,"literal",0)) D
...S ^XTMP("ORRDI","PSOO",DFN,I+1,9,0)=$$DTCONV($G(@GL@(I,"refillDispense",K,"fillDate",0,"literal",0)))
.I '$G(^XTMP("ORRDI","PSOO",DFN,I+1,9,0)) S ^XTMP("ORRDI","PSOO",DFN,I+1,9,0)=$$DTCONV($G(@GL@(I,"originalDispense",0,"fillDate",0,"literal",0)))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,10,0)=$G(@GL@(I,"numberOfRefillsAuthorized",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,11,0)=$G(@GL@(I,"originalDispense",0,"currentProvider",0,"name",0,"family",0))_","_$G(@GL@(I,"originalDispense",0,"currentProvider",0,"name",0,"given",0))
.S ^XTMP("ORRDI","PSOO",DFN,I+1,12,0)=$G(@GL@(I,"originalDispense",0,"dispensedDrug",0,"drugUnitPrice",0,"value",0))
.N L S L="" F S L=$O(@GL@(I,"sig",L)) Q:'$L(L) S ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=$G(^XTMP("ORRDI","PSOO",DFN,I+1,14,0))_" "_$G(@GL@(I,"sig",L))
.I '$D(^XTMP("ORRDI","PSOO",DFN,I+1,14,0)) S ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=""
.;S ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=$G(@GL@(I,"sig",0))
Q CNT
;
AL(DFN) ;expects ^TMP($J,"ORRDI")
K ^XTMP("ORRDI","ART",DFN)
N ORQ S ORQ=$$MSGERR Q:($L(ORQ)>0) -1_U_ORQ
N I,GL,CNT
S CNT=0,GL=$NA(^TMP($J,"ORRDI","ClinicalData",0,"patient",0,"intoleranceConditions"))
S I="" F S I=$O(@GL@(I)) Q:'$L(I) D
.S CNT=CNT+1
.I $D(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0)) D
..N RETURN
..D F4^XUAF4($G(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0)),.RETURN)
..I +RETURN>0 D
...S ^XTMP("ORRDI","ART",DFN,I+1,"FACILITY",0)=RETURN_U_$S(RETURN("VA NAME")'="":RETURN("VA NAME"),1:RETURN("NAME"))_U_RETURN("STATION NUMBER")
..I +RETURN=0 D
...S ^XTMP("ORRDI","ART",DFN,I+1,"FACILITY",0)=U_U_$G(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0))
.I $G(@GL@(I,"gmrAllergyAgent",0,"code",0)),$E($G(@GL@(I,"gmrAllergyAgent",0,"codingSystem",0)),1,4)="99VA" D
..S ^XTMP("ORRDI","ART",DFN,I+1,"GMRALLERGY",0)=@GL@(I,"gmrAllergyAgent",0,"code",0)_U_@GL@(I,"gmrAllergyAgent",0,"displayText",0)_U_@GL@(I,"gmrAllergyAgent",0,"codingSystem",0)
.I $D(@GL@(I,"agent",0,"code",0))#2 D
..S ^XTMP("ORRDI","ART",DFN,I+1,"REACTANT",0)=$G(@GL@(I,"agent",0,"code",0))
.I $D(@GL@(I,"reaction")) D
..N J S J="" F S J=$O(@GL@(I,"reaction",J)) Q:'$L(J) D
...I $E($G(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)),1,4)="99VA" D
....S ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1)=$G(@GL@(I,"reaction",J,"reaction",0,"code",0))_U_@GL@(I,"reaction",J,"reaction",0,"displayText",0)_U_@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)
...I $E($G(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)),1,4)'="99VA" D
....S ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1)=U_@GL@(I,"reaction",J,"reaction",0,"displayText",0)_U_$TR(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0),"`~!@#$%^&*()-_=+[{]}\|;:'"",<.>/?")
...I $G(@GL@(I,"reaction",J,"observationTime",0,"literal",0))'="" D
....S ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1,"DATE_ENTERED",0)=@GL@(I,"reaction",J,"observationTime",0,"literal",0)
.I $D(@GL@(I,"informationSourceCategory")) D
..Q:$E($G(@GL@(I,"informationSourceCategory",0,"codingSystem",0)),1,4)'="99VA"
..S ^XTMP("ORRDI","ART",DFN,I+1,"OBS/HISTORICAL",0)=$G(@GL@(I,"informationSourceCategory",0,"code",0))_U_@GL@(I,"informationSourceCategory",0,"displayText",0)_U_@GL@(I,"informationSourceCategory",0,"codingSystem",0)
.I $D(@GL@(I,"mechanism",0)) D
..Q:$E($G(@GL@(I,"mechanism",0,"codingSystem",0)),1,4)'="99VA"
..S ^XTMP("ORRDI","ART",DFN,I+1,"MECHANISM",0)=$G(@GL@(I,"mechanism",0,"code",0))_U_@GL@(I,"mechanism",0,"displayText",0)_U_@GL@(I,"mechanism",0,"codingSystem",0)
.I $D(@GL@(I,"severity",0)) D
..S ^XTMP("ORRDI","ART",DFN,I+1,"SEVERITY",0)=$G(@GL@(I,"severity",0,"value",0,"code",0))_U_$G(@GL@(I,"severity",0,"value",0,"displayText",0))
.I $D(@GL@(I,"verified",0)) D
..S ^XTMP("ORRDI","ART",DFN,I+1,"VERIFIED",0)=$G(@GL@(I,"verified",0))
.I $D(@GL@(I,"allergyType",0)) D
..Q:$E($G(@GL@(I,"allergyType",0,"codingSystem",0)),1,4)'="L"
..S ^XTMP("ORRDI","ART",DFN,I+1,"TYPE",0)=$G(@GL@(I,"allergyType",0,"code",0))_U_@GL@(I,"allergyType",0,"displayText",0)_U_@GL@(I,"allergyType",0,"codingSystem",0)
.I $D(@GL@(I,"observationTime",0,"literal",0)) D
..;observationTime is mapped to ORIGINATION DATE/TIME field in file #120.8
..S ^XTMP("ORRDI","ART",DFN,I+1,"ORIGINATION DATE/TIME",0)=$G(@GL@(I,"observationTime",0,"literal",0))
.I $D(@GL@(I,"author",0)) D
..S ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=$G(@GL@(I,"author",0,"practitioner",0,"name",0,"family",0))_U
..S ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)_$G(@GL@(I,"author",0,"practitioner",0,"name",0,"given",0))_U
..S ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)_$G(@GL@(I,"author",0,"practitioner",0,"name",0,"middle",0))
.I $D(@GL@(I,"drugIngredient")) D
..N J S J="" F S J=$O(@GL@(I,"drugIngredient",J)) Q:'$L(J) D
...I $G(@GL@(I,"drugIngredient",J,"code",0,"code",0)),$E($G(@GL@(I,"drugIngredient",J,"code",0,"codingSystem",0)),1,4)="99VA" D
....S ^XTMP("ORRDI","ART",DFN,I+1,"DRUG INGREDIENTS",J+1)=@GL@(I,"drugIngredient",J,"code",0,"code",0)_U_@GL@(I,"drugIngredient",J,"code",0,"displayText",0)_U_@GL@(I,"drugIngredient",J,"code",0,"codingSystem",0)
.I $D(@GL@(I,"drugClass")) D
..N J S J="" F S J=$O(@GL@(I,"drugClass",J)) Q:'$L(J) D
...Q:$E($G(@GL@(I,"drugClass",0,"code",0,"codingSystem",0)),1,4)'="99VA"
...S ^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)=@GL@(I,"drugClass",J,"code",0,"code",0)_U_@GL@(I,"drugClass",J,"code",0,"displayText",0)_U_$G(@GL@(I,"drugClass",J,"code",0,"codingSystem",0))
...S ^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)=^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)_U_$G(@GL@(I,"drugClass",J,"code",0,"alternateCode",0))
S GL=$NA(^TMP($J,"ORRDI","ClinicalData",0,"patient",0,"allergyAssessments"))
S I="" F S I=$O(@GL@(I)) Q:'$L(I) D
.S ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1)=$G(@GL@(I,"assessmentValue",0,"code",0))_U_$G(@GL@(I,"assessmentValue",0,"displayText",0))_U_$G(@GL@(I,"assessmentValue",0,"codingSystem",0))
.N RETURN
.D F4^XUAF4($G(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0)),.RETURN)
.I +RETURN>0 D
..S ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1,"FACILITY",0)=RETURN_U_$S(RETURN("VA NAME")'="":RETURN("VA NAME"),1:RETURN("NAME"))_U_RETURN("STATION NUMBER")
.I +RETURN=0 D
..S ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1,"FACILITY",0)=U_U_$G(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0))
Q CNT
;
HAVEHDR() ;call to check if this system has an HDR to perform order checks
; against
;check parameter to see if there is an HDR and returns positive if so
I $$GET^XPAR("SYS","OR RDI HAVE HDR") Q 1
;returns negative because the parameter indicates there is no HDR
Q 0
;
DTCONV(DATE) ;convert date in hl7 format to mm/dd/yy
I '$L(DATE) Q ""
Q $E(DATE,5,6)_"/"_$E(DATE,7,8)_"/"_$E(DATE,3,4)
;
PARSE(STREAM) ;
N %XML,GL
S GL=$NA(^TMP($J,"ORRDI"))
K @GL
N STATUS,READER,XOBERR,S
S STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
I $$STATCHK^XOBWLIB(STATUS,.XOBERR,1) D
.N BREAK
.S BREAK=0 F Q:BREAK||READER.EOF||'READER.Read() D
..N X
..I READER.NodeType="element" D SPUSH(.S,READER.LocalName)
..I READER.NodeType="endelement" D SPOP(.S,.X)
..I READER.NodeType="chars" D SPUT(.S,READER.Value)
Q
;
SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
N I S I=$O(S(""),-1)+1,S(I)=X
Q I
;
SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
N I S I=$O(S(""),-1)
I I S X=S(I) K S(I)
N J S J=$O(S(I),-1) I J S S(J,X)=$G(S(J,X))+1
Q I
;
SPEEK(S,X) ;same as SPOP except the top item is not removed
N I S I=$O(S(""),-1)
I I S X=S(I)
Q I
;
SPUT(S,X) ;implementation specific, uses the stack to form a global node
N I,STR
S STR=$P(GL,")")
S I=0 F S I=$O(S(I)) Q:'I D
.S STR=STR_","_""""_S(I)_""""_","
.N NUM S NUM=0
.I $D(S(I-1,S(I))) S NUM=+$G(S(I-1,S(I)))
.S STR=STR_NUM
S STR=STR_")"
I $D(@STR) S @STR=@STR_X
I '$D(@STR) S @STR=X
Q STR
;
MSGERR() ;check errors from XML return
;returns empty string "" if there was no error
;returns empty string "" if the only error was "ALL_PATIENT_IDS_EXCLUDED"
;otherwise returns the exceptionMessage string from the errorSection
N ORRET S ORRET=""
I $D(^TMP($J,"ORRDI","ClinicalData",0,"errorSection")) D
.N I F I="fatalErrors","errors","warnings" D
..N J S J="" F S J=$O(^TMP($J,"ORRDI","ClinicalData",0,"errorSection",0,I,J)) Q:J="" D
...N ORSTR S ORSTR=$G(^TMP($J,"ORRDI","ClinicalData",0,"errorSection",0,I,J,"errorCode",0))
...I ORSTR'="ALL_PATIENT_IDS_EXCLUDED" S ORRET=ORSTR
Q ORRET
ERRHNDL(DFN) ;handle any errors that may get thrown in call to GET^ORRDI1
K ^TMP($J,"ORRDI"),^XTMP("ORRDI","PSOO",DFN),^XTMP("ORRDI","ART",DFN)
D UNWIND^%ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRDI1 15518 printed Apr 09, 2024@21:39:48 Page 2
ORRDI1 ;SLC/JMH - RDI ROUTINES FOR API SUPPORTING CDS DATA ;Nov 16, 2022@13:03:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,294,306,269,591,588**;Dec 17, 1997;Build 29
+2 ; SAC EXEMPTION 202211140901-03 : Non-standard $Z special variable used
+3 ;
GET(DFN,DOMAIN) ;API for packages to call in order to get data from HDR for
+1 IF '$LENGTH($GET(DOMAIN))
SET DOMAIN="ART"
+2 ; check if in OUTAGE state and quit if so
+3 IF $$DOWNXVAL^ORRDI2
Begin DoDot:1
+4 KILL ^XTMP("ORRDI",DOMAIN,DFN)
+5 SET ^XTMP("ORRDI",DOMAIN,DFN,0)="^^-1"
End DoDot:1
QUIT -1
+6 ; order checking purposes
+7 NEW I,ORCACHE,ORRET,ORRECDT
+8 ;check if data was just retrieved a short time ago and if so return
+9 SET ORRECDT=$PIECE($GET(^XTMP("ORRDI",DOMAIN,DFN,0)),U)
IF 'ORRECDT
SET ORRECDT=3000101
+10 SET ORCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
+11 IF $$FMDIFF^XLFDT($$NOW^XLFDT,ORRECDT,2)<(60*ORCACHE)
IF $PIECE(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)>-1
SET ORRET=$PIECE(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)
+12 ;check if there has been an HDR down condition within last minute
+13 IF $$FMDIFF^XLFDT($$NOW^XLFDT,$PIECE($GET(^XTMP("ORRDI","PSOO",DFN,0)),U),2)<60
IF $PIECE($GET(^XTMP("ORRDI","PSOO",DFN,0)),U,3)<0
SET ORRET=$PIECE($GET(^XTMP("ORRDI","PSOO",DFN,0)),U,3)
+14 IF $$FMDIFF^XLFDT($$NOW^XLFDT,$PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),U),2)<60
IF $PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),U,3)<0
SET ORRET=$PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),U,3)
+15 ;if data is not "fresh" then go get it
+16 IF '$LENGTH($GET(ORRET))
Begin DoDot:1
+17 SET ORRET=$$RETRIEVE(DFN,DOMAIN)
+18 IF ORRET>-1
SET ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=0
+19 IF ORRET'>-1
Begin DoDot:2
+20 if $PIECE(ORRET,U,2)="PATIENT ICN NOT FOUND"
QUIT
+21 IF ORRET=-9
SET ORRET="-1^PROCESSING ERROR"
QUIT
+22 SET ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=$$FAILXVAL^ORRDI2+1
+23 IF $$FAILXVAL^ORRDI2'<$$FAILPVAL^ORRDI2
Begin DoDot:3
+24 SET ^XTMP("ORRDI","OUTAGE INFO","DOWN")=1
+25 DO SPAWN^ORRDI2
End DoDot:3
End DoDot:2
End DoDot:1
+26 SET $PIECE(^XTMP("ORRDI",DOMAIN,DFN,0),U,3,4)=ORRET
+27 QUIT ORRET
+28 ;
RETRIEVE(DFN,DOMAIN) ;GET DATA
+1 NEW $ESTACK,$ETRAP
+2 SET $ETRAP="D ERRHNDL^ORRDI1(DFN) Q -1"
+3 NEW Y,ORCSTART,ORPSTART,ORCDIF,ORPDIF,ORALNUM,ORPSNUM,ORREQ,ORXML,ORERR,ORRET,ORY,START,FACIL,ICN
+4 KILL ^TMP($JOB,"ORRDI")
+5 SET ORY=-1
+6 IF '$LENGTH($GET(DOMAIN))
SET DOMAIN="ART"
+7 ;GET ICN
+8 SET ICN=$$GETICN^MPIF001(DFN)
+9 IF +ICN<0
QUIT -1_"^PATIENT ICN NOT FOUND"
+10 SET START=$$FMADD^XLFDT($PIECE($$NOW^XLFDT,"."),-30)
+11 SET START=$$FMTHL7^XLFDT(START)
+12 SET START=$EXTRACT(START,1,4)_"-"_$EXTRACT(START,5,6)_"-"_$EXTRACT(START,7,8)
+13 SET FACIL=$PIECE($$SITE^VASITE,U,3)
+14 ;format request XML
+15 SET ORREQ="/readClinicalData1?&templateId=RDIAllergiesPharmacyRead40013&"
+16 SET ORREQ=ORREQ_"filterRequest=<?xml version=""1.0"" encoding=""UTF-8""?>"
+17 SET ORREQ=ORREQ_"<filter:filter vhimVersion=""Vhim_4_00"" xmlns:filter=""Filter"" "
+18 SET ORREQ=ORREQ_"xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"">"
+19 SET ORREQ=ORREQ_"<filterId>RDI_ALLERGY_RX_SINGLE_PATIENT_FILTER</filterId>"
+20 SET ORREQ=ORREQ_"<clientName>RDI</clientName><patients><NationalId>"_ICN_"</NationalId>"
+21 SET ORREQ=ORREQ_"<excludeIdentifiers><assigningAuthority>USVHA</assigningAuthority>"
+22 SET ORREQ=ORREQ_"<assigningFacility>"_FACIL_"</assigningFacility></excludeIdentifiers></patients>"
+23 SET ORREQ=ORREQ_"<entryPointFilter queryName=""IC-Standardized""><domainEntryPoint>IntoleranceCondition</domainEntryPoint>"
+24 SET ORREQ=ORREQ_"<xpathQuery><xpath>intoleranceConditions[((gmrAllergyAgent[(code!='') and (codingSystem = '99"
+25 SET ORREQ=ORREQ_"VHA_ERT' or contains(.,'99VA'))]) or (drugClass/code[(code!='') and (codingSystem = '99VHA_ERT' or co"
+26 SET ORREQ=ORREQ_"ntains(.,'99VA'))]) or (drugIngredient/code[(code!='') and (codingSystem = '99VHA_ERT' or contain"
+27 SET ORREQ=ORREQ_"s(.,'99VA'))])) and (status = 'F')]</xpath></xpathQuery></entryPointFilter>"
+28 SET ORREQ=ORREQ_"<entryPointFilter queryName=""OMP-Standardized"">"
+29 SET ORREQ=ORREQ_"<domainEntryPoint>OutpatientMedicationPromise</domainEntryPoint>"
+30 SET ORREQ=ORREQ_"<startDate>"_START_"</startDate><xpathQuery><xpath>outpatientMedicationPromises[pharmacyRe"
+31 SET ORREQ=ORREQ_"quest/orderedMedication/medicationCode[(code!='') and (codingSystem = '99VHA_ERT' or contain"
+32 SET ORREQ=ORREQ_"s(.,'99VA'))]]</xpath></xpathQuery></entryPointFilter><entryPointFilter queryName=""AA-Standardized"">"
+33 SET ORREQ=ORREQ_"<domainEntryPoint>AllergyAssessment</domainEntryPoint></entryPointFilter></filter:filter>"
+34 SET ORCSTART=$ZH
+35 SET ORREQ=ORREQ_"&filterId=RDI_ALLERGY_RX_SINGLE_PATIENT_FILTER&requestId="_FACIL_"RDI"_$$NOW^XLFDT_";"_ORCSTART
+36 ;make call to HDR
+37 SET ORXML=$$GETREST^XOBWLIB("CDS WEB SERVICE","CDS SERVER")
+38 SET ORRET=$$GET^XOBWLIB(ORXML,ORREQ,.ORERR,0)
+39 SET ORCDIF=$ZH-ORCSTART
+40 IF ORRET
Begin DoDot:1
+41 ;parse out xml into temp global
+42 SET ORPSTART=$ZH
+43 DO PARSE(ORXML.HttpResponse.Data)
+44 SET ORPDIF=$ZH-ORCSTART-ORCDIF
+45 ;move from temp global into ^XTMP("ORRDI" domain globals
+46 SET ORALNUM=$$AL(DFN)
+47 SET ORPSNUM=$$PS(DFN)
+48 SET ^XTMP("ORRDI","ART",DFN,0)=$$NOW^XLFDT_U_U_ORALNUM
+49 SET ^XTMP("ORRDI","PSOO",DFN,0)=$$NOW^XLFDT_U_U_ORPSNUM
+50 SET ^XTMP("ORRDI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
+51 IF DOMAIN="ART"
SET ORY=ORALNUM
+52 IF DOMAIN="PSOO"
SET ORY=ORPSNUM
+53 IF +ORY>-1
SET ^XTMP("ORRDI","TESTREQ")=ORREQ
+54 ;set metrics for data retrieval and parsing
+55 SET ^XTMP("ORRDI","METRICS",$$NOW^XLFDT,ORCSTART)=DFN_U_ORCDIF_U_ORPDIF_U_ORALNUM_U_ORPSNUM
+56 KILL ^TMP($JOB,"ORRDI")
End DoDot:1
QUIT ORY
+57 IF 'ORRET!(ORERR)
SET ^XTMP("ORRDI","METRICS",$$NOW^XLFDT,ORCSTART)=DFN_U_"ERROR"
Begin DoDot:1
+58 SET ^XTMP("ORRDI","ART",DFN,0)=U_U_"-1^"_ORERR
+59 SET ^XTMP("ORRDI","PSOO",DFN,0)=U_U_"-1^"_ORERR
End DoDot:1
QUIT "-1^"_ORERR
+60 QUIT -1
+61 ;
PS(DFN) ;expects ^TMP($J,"ORRDI")
+1 KILL ^XTMP("ORRDI","PSOO",DFN)
+2 NEW ORQ
SET ORQ=$$MSGERR
if ($LENGTH(ORQ)>0)
QUIT -1_U_ORQ
+3 NEW I,GL,CNT
+4 SET CNT=0
SET GL=$NAME(^TMP($JOB,"ORRDI","ClinicalData",0,"patient",0,"outpatientMedicationPromises"))
+5 SET I=""
FOR
SET I=$ORDER(@GL@(I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 SET ^XTMP("ORRDI","PSOO",DFN,I+1,1,0)=$GET(@GL@(I,"pharmacyRequest",0,"orderingInstitutionIdentifier",0,"name",0))
+8 SET ^XTMP("ORRDI","PSOO",DFN,I+1,2,0)=$GET(@GL@(I,"pharmacyRequest",0,"orderedMedication",0,"medicationCode",0,"displayText",0))
+9 SET ^XTMP("ORRDI","PSOO",DFN,I+1,3,0)=$GET(@GL@(I,"pharmacyRequest",0,"orderedMedication",0,"medicationCode",0,"code",0))
+10 SET ^XTMP("ORRDI","PSOO",DFN,I+1,4,0)=$GET(@GL@(I,"prescriptionId",0))
+11 SET ^XTMP("ORRDI","PSOO",DFN,I+1,5,0)=$GET(@GL@(I,"pharmacyRequest",0,"statusModifier",0,"displayText",0))
+12 SET ^XTMP("ORRDI","PSOO",DFN,I+1,6,0)=$GET(@GL@(I,"originalDispense",0,"quantityDispensed",0,"value",0))_";"_$GET(@GL@(I,"originalDispense",0,"daysSupply",0))
+13 SET ^XTMP("ORRDI","PSOO",DFN,I+1,7,0)=$$DTCONV($GET(@GL@(I,"expirationDate",0,"literal",0)))
+14 SET ^XTMP("ORRDI","PSOO",DFN,I+1,8,0)=$$DTCONV($GET(@GL@(I,"pharmacyRequest",0,"orderDate",0,"literal",0)))
+15 NEW K
SET K=""
FOR
SET K=$ORDER(@GL@(I,"refillDispense",K))
if '$LENGTH(K)
QUIT
Begin DoDot:2
+16 IF $GET(@GL@(I,"refillDispense",K,"fillDate",0,"literal",0))
Begin DoDot:3
+17 SET ^XTMP("ORRDI","PSOO",DFN,I+1,9,0)=$$DTCONV($GET(@GL@(I,"refillDispense",K,"fillDate",0,"literal",0)))
End DoDot:3
End DoDot:2
+18 IF '$GET(^XTMP("ORRDI","PSOO",DFN,I+1,9,0))
SET ^XTMP("ORRDI","PSOO",DFN,I+1,9,0)=$$DTCONV($GET(@GL@(I,"originalDispense",0,"fillDate",0,"literal",0)))
+19 SET ^XTMP("ORRDI","PSOO",DFN,I+1,10,0)=$GET(@GL@(I,"numberOfRefillsAuthorized",0))
+20 SET ^XTMP("ORRDI","PSOO",DFN,I+1,11,0)=$GET(@GL@(I,"originalDispense",0,"currentProvider",0,"name",0,"family",0))_","_$GET(@GL@(I,"originalDispense",0,"currentProvider",0,"name",0,"given",0))
+21 SET ^XTMP("ORRDI","PSOO",DFN,I+1,12,0)=$GET(@GL@(I,"originalDispense",0,"dispensedDrug",0,"drugUnitPrice",0,"value",0))
+22 NEW L
SET L=""
FOR
SET L=$ORDER(@GL@(I,"sig",L))
if '$LENGTH(L)
QUIT
SET ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=$GET(^XTMP("ORRDI","PSOO",DFN,I+1,14,0))_" "_$GET(@GL@(I,"sig",L))
+23 IF '$DATA(^XTMP("ORRDI","PSOO",DFN,I+1,14,0))
SET ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=""
+24 ;S ^XTMP("ORRDI","PSOO",DFN,I+1,14,0)=$G(@GL@(I,"sig",0))
End DoDot:1
+25 QUIT CNT
+26 ;
AL(DFN) ;expects ^TMP($J,"ORRDI")
+1 KILL ^XTMP("ORRDI","ART",DFN)
+2 NEW ORQ
SET ORQ=$$MSGERR
if ($LENGTH(ORQ)>0)
QUIT -1_U_ORQ
+3 NEW I,GL,CNT
+4 SET CNT=0
SET GL=$NAME(^TMP($JOB,"ORRDI","ClinicalData",0,"patient",0,"intoleranceConditions"))
+5 SET I=""
FOR
SET I=$ORDER(@GL@(I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 IF $DATA(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0))
Begin DoDot:2
+8 NEW RETURN
+9 DO F4^XUAF4($GET(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0)),.RETURN)
+10 IF +RETURN>0
Begin DoDot:3
+11 SET ^XTMP("ORRDI","ART",DFN,I+1,"FACILITY",0)=RETURN_U_$SELECT(RETURN("VA NAME")'="":RETURN("VA NAME"),1:RETURN("NAME"))_U_RETURN("STATION NUMBER")
End DoDot:3
+12 IF +RETURN=0
Begin DoDot:3
+13 SET ^XTMP("ORRDI","ART",DFN,I+1,"FACILITY",0)=U_U_$GET(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0))
End DoDot:3
End DoDot:2
+14 IF $GET(@GL@(I,"gmrAllergyAgent",0,"code",0))
IF $EXTRACT($GET(@GL@(I,"gmrAllergyAgent",0,"codingSystem",0)),1,4)="99VA"
Begin DoDot:2
+15 SET ^XTMP("ORRDI","ART",DFN,I+1,"GMRALLERGY",0)=@GL@(I,"gmrAllergyAgent",0,"code",0)_U_@GL@(I,"gmrAllergyAgent",0,"displayText",0)_U_@GL@(I,"gmrAllergyAgent",0,"codingSystem",0)
End DoDot:2
+16 IF $DATA(@GL@(I,"agent",0,"code",0))#2
Begin DoDot:2
+17 SET ^XTMP("ORRDI","ART",DFN,I+1,"REACTANT",0)=$GET(@GL@(I,"agent",0,"code",0))
End DoDot:2
+18 IF $DATA(@GL@(I,"reaction"))
Begin DoDot:2
+19 NEW J
SET J=""
FOR
SET J=$ORDER(@GL@(I,"reaction",J))
if '$LENGTH(J)
QUIT
Begin DoDot:3
+20 IF $EXTRACT($GET(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)),1,4)="99VA"
Begin DoDot:4
+21 SET ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1)=$GET(@GL@(I,"reaction",J,"reaction",0,"code",0))_U_@GL@(I,"reaction",J,"reaction",0,"displayText",0)_U_@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)
End DoDot:4
+22 IF $EXTRACT($GET(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0)),1,4)'="99VA"
Begin DoDot:4
+23 SET ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1)=U_@GL@(I,"reaction",J,"reaction",0,"displayText",0)_U_$TRANSLATE(@GL@(I,"reaction",J,"reaction",0,"codingSystem",0),"`~!@#$%^&*()-_=+[{]}\|;:'"",<.>/?")
End DoDot:4
+24 IF $GET(@GL@(I,"reaction",J,"observationTime",0,"literal",0))'=""
Begin DoDot:4
+25 SET ^XTMP("ORRDI","ART",DFN,I+1,"SIGNS/SYMPTOMS",J+1,"DATE_ENTERED",0)=@GL@(I,"reaction",J,"observationTime",0,"literal",0)
End DoDot:4
End DoDot:3
End DoDot:2
+26 IF $DATA(@GL@(I,"informationSourceCategory"))
Begin DoDot:2
+27 if $EXTRACT($GET(@GL@(I,"informationSourceCategory",0,"codingSystem",0)),1,4)'="99VA"
QUIT
+28 SET ^XTMP("ORRDI","ART",DFN,I+1,"OBS/HISTORICAL",0)=$GET(@GL@(I,"informationSourceCategory",0,"code",0))_U_@GL@(I,"informationSourceCategory",0,"displayText",0)_U_@GL@(I,"informationSourceCategory",0,"codingSystem",0)
End DoDot:2
+29 IF $DATA(@GL@(I,"mechanism",0))
Begin DoDot:2
+30 if $EXTRACT($GET(@GL@(I,"mechanism",0,"codingSystem",0)),1,4)'="99VA"
QUIT
+31 SET ^XTMP("ORRDI","ART",DFN,I+1,"MECHANISM",0)=$GET(@GL@(I,"mechanism",0,"code",0))_U_@GL@(I,"mechanism",0,"displayText",0)_U_@GL@(I,"mechanism",0,"codingSystem",0)
End DoDot:2
+32 IF $DATA(@GL@(I,"severity",0))
Begin DoDot:2
+33 SET ^XTMP("ORRDI","ART",DFN,I+1,"SEVERITY",0)=$GET(@GL@(I,"severity",0,"value",0,"code",0))_U_$GET(@GL@(I,"severity",0,"value",0,"displayText",0))
End DoDot:2
+34 IF $DATA(@GL@(I,"verified",0))
Begin DoDot:2
+35 SET ^XTMP("ORRDI","ART",DFN,I+1,"VERIFIED",0)=$GET(@GL@(I,"verified",0))
End DoDot:2
+36 IF $DATA(@GL@(I,"allergyType",0))
Begin DoDot:2
+37 if $EXTRACT($GET(@GL@(I,"allergyType",0,"codingSystem",0)),1,4)'="L"
QUIT
+38 SET ^XTMP("ORRDI","ART",DFN,I+1,"TYPE",0)=$GET(@GL@(I,"allergyType",0,"code",0))_U_@GL@(I,"allergyType",0,"displayText",0)_U_@GL@(I,"allergyType",0,"codingSystem",0)
End DoDot:2
+39 IF $DATA(@GL@(I,"observationTime",0,"literal",0))
Begin DoDot:2
+40 ;observationTime is mapped to ORIGINATION DATE/TIME field in file #120.8
+41 SET ^XTMP("ORRDI","ART",DFN,I+1,"ORIGINATION DATE/TIME",0)=$GET(@GL@(I,"observationTime",0,"literal",0))
End DoDot:2
+42 IF $DATA(@GL@(I,"author",0))
Begin DoDot:2
+43 SET ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=$GET(@GL@(I,"author",0,"practitioner",0,"name",0,"family",0))_U
+44 SET ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)_$GET(@GL@(I,"author",0,"practitioner",0,"name",0,"given",0))_U
+45 SET ^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)=^XTMP("ORRDI","ART",DFN,I+1,"AUTHOR",0)_$GET(@GL@(I,"author",0,"practitioner",0,"name",0,"middle",0))
End DoDot:2
+46 IF $DATA(@GL@(I,"drugIngredient"))
Begin DoDot:2
+47 NEW J
SET J=""
FOR
SET J=$ORDER(@GL@(I,"drugIngredient",J))
if '$LENGTH(J)
QUIT
Begin DoDot:3
+48 IF $GET(@GL@(I,"drugIngredient",J,"code",0,"code",0))
IF $EXTRACT($GET(@GL@(I,"drugIngredient",J,"code",0,"codingSystem",0)),1,4)="99VA"
Begin DoDot:4
+49 SET ^XTMP("ORRDI","ART",DFN,I+1,"DRUG INGREDIENTS",J+1)=@GL@(I,"drugIngredient",J,"code",0,"code",0)_U_@GL@(I,"drugIngredient",J,"code",0,"displayText",0)_U_@GL@(I,"drugIngredient",J,"code",0,"codingSystem",0
)
End DoDot:4
End DoDot:3
End DoDot:2
+50 IF $DATA(@GL@(I,"drugClass"))
Begin DoDot:2
+51 NEW J
SET J=""
FOR
SET J=$ORDER(@GL@(I,"drugClass",J))
if '$LENGTH(J)
QUIT
Begin DoDot:3
+52 if $EXTRACT($GET(@GL@(I,"drugClass",0,"code",0,"codingSystem",0)),1,4)'="99VA"
QUIT
+53 SET ^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)=@GL@(I,"drugClass",J,"code",0,"code",0)_U_@GL@(I,"drugClass",J,"code",0,"displayText",0)_U_$GET(@GL@(I,"drugClass",J,"code",0,"codingSystem",0))
+54 SET ^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)=^XTMP("ORRDI","ART",DFN,I+1,"DRUG CLASSES",J+1)_U_$GET(@GL@(I,"drugClass",J,"code",0,"alternateCode",0))
End DoDot:3
End DoDot:2
End DoDot:1
+55 SET GL=$NAME(^TMP($JOB,"ORRDI","ClinicalData",0,"patient",0,"allergyAssessments"))
+56 SET I=""
FOR
SET I=$ORDER(@GL@(I))
if '$LENGTH(I)
QUIT
Begin DoDot:1
+57 SET ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1)=$GET(@GL@(I,"assessmentValue",0,"code",0))_U_$GET(@GL@(I,"assessmentValue",0,"displayText",0))_U_$GET(@GL@(I,"assessmentValue",0,"codingSystem",0))
+58 NEW RETURN
+59 DO F4^XUAF4($GET(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0)),.RETURN)
+60 IF +RETURN>0
Begin DoDot:2
+61 SET ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1,"FACILITY",0)=RETURN_U_$SELECT(RETURN("VA NAME")'="":RETURN("VA NAME"),1:RETURN("NAME"))_U_RETURN("STATION NUMBER")
End DoDot:2
+62 IF +RETURN=0
Begin DoDot:2
+63 SET ^XTMP("ORRDI","ART",DFN,"ASSESSMENT",I+1,"FACILITY",0)=U_U_$GET(@GL@(I,"patient",0,"identifier",0,"assigningFacility",0))
End DoDot:2
End DoDot:1
+64 QUIT CNT
+65 ;
HAVEHDR() ;call to check if this system has an HDR to perform order checks
+1 ; against
+2 ;check parameter to see if there is an HDR and returns positive if so
+3 IF $$GET^XPAR("SYS","OR RDI HAVE HDR")
QUIT 1
+4 ;returns negative because the parameter indicates there is no HDR
+5 QUIT 0
+6 ;
DTCONV(DATE) ;convert date in hl7 format to mm/dd/yy
+1 IF '$LENGTH(DATE)
QUIT ""
+2 QUIT $EXTRACT(DATE,5,6)_"/"_$EXTRACT(DATE,7,8)_"/"_$EXTRACT(DATE,3,4)
+3 ;
PARSE(STREAM) ;
+1 NEW %XML,GL
+2 SET GL=$NAME(^TMP($JOB,"ORRDI"))
+3 KILL @GL
+4 NEW STATUS,READER,XOBERR,S
+5 SET STATUS=##class(%XML.TextReader).ParseStream(STREAM,.READER,,,,,1)
+6 IF $$STATCHK^XOBWLIB(STATUS,.XOBERR,1)
Begin DoDot:1
+7 NEW BREAK
+8 SET BREAK=0
FOR
if BREAK||READER.EOF||'READER.Read()
QUIT
Begin DoDot:2
+9 NEW X
+10 IF READER.NodeType="element"
DO SPUSH(.S,READER.LocalName)
+11 IF READER.NodeType="endelement"
DO SPOP(.S,.X)
+12 IF READER.NodeType="chars"
DO SPUT(.S,READER.Value)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
SPUSH(S,X) ;places X on the stack S and returns the current level of the stack
+1 NEW I
SET I=$ORDER(S(""),-1)+1
SET S(I)=X
+2 QUIT I
+3 ;
SPOP(S,X) ;removes the top item from the stack S and put it into the variable X and returns the level that X was at
+1 NEW I
SET I=$ORDER(S(""),-1)
+2 IF I
SET X=S(I)
KILL S(I)
+3 NEW J
SET J=$ORDER(S(I),-1)
IF J
SET S(J,X)=$GET(S(J,X))+1
+4 QUIT I
+5 ;
SPEEK(S,X) ;same as SPOP except the top item is not removed
+1 NEW I
SET I=$ORDER(S(""),-1)
+2 IF I
SET X=S(I)
+3 QUIT I
+4 ;
SPUT(S,X) ;implementation specific, uses the stack to form a global node
+1 NEW I,STR
+2 SET STR=$PIECE(GL,")")
+3 SET I=0
FOR
SET I=$ORDER(S(I))
if 'I
QUIT
Begin DoDot:1
+4 SET STR=STR_","_""""_S(I)_""""_","
+5 NEW NUM
SET NUM=0
+6 IF $DATA(S(I-1,S(I)))
SET NUM=+$GET(S(I-1,S(I)))
+7 SET STR=STR_NUM
End DoDot:1
+8 SET STR=STR_")"
+9 IF $DATA(@STR)
SET @STR=@STR_X
+10 IF '$DATA(@STR)
SET @STR=X
+11 QUIT STR
+12 ;
MSGERR() ;check errors from XML return
+1 ;returns empty string "" if there was no error
+2 ;returns empty string "" if the only error was "ALL_PATIENT_IDS_EXCLUDED"
+3 ;otherwise returns the exceptionMessage string from the errorSection
+4 NEW ORRET
SET ORRET=""
+5 IF $DATA(^TMP($JOB,"ORRDI","ClinicalData",0,"errorSection"))
Begin DoDot:1
+6 NEW I
FOR I="fatalErrors","errors","warnings"
Begin DoDot:2
+7 NEW J
SET J=""
FOR
SET J=$ORDER(^TMP($JOB,"ORRDI","ClinicalData",0,"errorSection",0,I,J))
if J=""
QUIT
Begin DoDot:3
+8 NEW ORSTR
SET ORSTR=$GET(^TMP($JOB,"ORRDI","ClinicalData",0,"errorSection",0,I,J,"errorCode",0))
+9 IF ORSTR'="ALL_PATIENT_IDS_EXCLUDED"
SET ORRET=ORSTR
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT ORRET
ERRHNDL(DFN) ;handle any errors that may get thrown in call to GET^ORRDI1
+1 KILL ^TMP($JOB,"ORRDI"),^XTMP("ORRDI","PSOO",DFN),^XTMP("ORRDI","ART",DFN)
+2 DO UNWIND^%ZTER
+3 QUIT
