- 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 Jan 18, 2025@03:35:04 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