Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERXIH

PSOERXIH.m

Go to the documentation of this file.
  1. PSOERXIH ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
  1. ;
  1. Q
  1. OMEDDATE(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file other medication date data ; ***ask Brad about date/time, not sure if we need that field
  1. N OGL,I,SEQUENCE,SF,DATE,QUAL,IENS,FDA,SF,EFFDT,FDA,EXDT
  1. S OGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
  1. S I=-1,SEQUENCE=0,SF=52.4931162
  1. F S I=$O(@OGL@("OtherMedicationDate",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S DATE=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"Date",0))
  1. .I '$L(DATE) S DATE=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"DateTime",0))
  1. .S DATE=$$CONVDTTM^PSOERXA1(DATE)
  1. .S QUAL=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDateQualifier",0))
  1. .I QUAL="EffectiveDate" S EFFDT=DATE
  1. .I QUAL="ExpirationDate" S EXDT=DATE
  1. .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
  1. .; sequence, other medicaiton date, other medication date qualifier
  1. .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=DATE,FDA(SF,IENS,.03)=QUAL
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. ; file the effective and expiration dates in the old fields as well.
  1. I $D(EFFDT) S FDA(52.49,ERXIEN_",",6.3)=EFFDT
  1. I $D(EXDT) S FDA(52.49,ERXIEN_",",6.2)=EXDT
  1. I $D(FDA) D FILE^DIE(,"FDA") K FDA
  1. Q
  1. FACTIME(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file facility specific hours of administration timing data
  1. N FGL,I,SEQUENCE,SF,ADCODE,ADQUAL,ADTEXT,ADVAL,IENS,FDA,SF
  1. S FGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
  1. S I=-1,SEQUENCE=0,SF=52.4931161
  1. F S I=$O(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S ADCODE=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Code",0))
  1. .S ADQUAL=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Qualifier",0))
  1. .S ADTEXT=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Text",0))
  1. .S ADVAL=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministrationValue",0))
  1. .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
  1. .; sequence, hours of administration code, hours of adminstraiton qualifier, hours of adminstration text, hours of adminstration value
  1. .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=ADVAL,FDA(SF,IENS,1)=ADTEXT,FDA(SF,IENS,2.1)=ADQUAL,FDA(SF,IENS,2.2)=ADCODE
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. PATNOTES(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file patient codified notes
  1. N PGL,I,SEQUENCE,SF,QUAL,VALUE,IENS,FDA,SF
  1. S PGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
  1. S I=-1,SEQUENCE=0,SF=52.4931159
  1. F S I=$O(@PGL@("PatientCodifiedNote",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S QUAL=$G(@PGL@("PatientCodifiedNote",I,"Qualifier",0))
  1. .S VALUE=$G(@PGL@("PatientCodifiedNote",I,"Value",0))
  1. .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
  1. .; sequence, qualifier, value
  1. .S QUAL=$$PRESOLV^PSOERXA1(QUAL,"PCQ") ; resolving pointer
  1. .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=QUAL,FDA(SF,IENS,.03)=VALUE
  1. D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. COMPOUND(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file compound ingredient information
  1. ; create field in 52.49311 after the compound ingredients multiple. field will live outside of the loop (1 instance) - final compound pharamceutical dosage form
  1. N CGL,I,SF,SEQUENCE,COMPID,DEA,INCODE,INQUAL,STRFORM,STRUOMCD,STRVAL,ACKREA,CLINSC,COAGCODE,COAGQUAL,PROFSC,REACODE,RESCODE,CLQUAL,QUOMCODE,QUANTITY,IENS,FDA
  1. N SF,COAGDESC,FNLCMPDF
  1. S CGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0,"CompoundInformation",0))
  1. S I=-1,SEQUENCE=0,SF=52.4931157
  1. F S I=$O(@CGL@("CompoundIngredientsLotNotUsed",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S COMPID=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"CompoundIngredientItemDescription",0))
  1. .S DEA=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"DEASchedule",0,"Code",0))
  1. .S INCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Code",0))
  1. .S INQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Qualifier",0))
  1. .S STRFORM=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthForm",0,"Code",0))
  1. .S STRUOMCD=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthUnitOfMeasure",0,"Code",0))
  1. .S STRVAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthValue",0))
  1. .S ACKREA=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"AcknowledgementReason",0))
  1. .S CLINSC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ClinicalSignificanceCode",0))
  1. .S COAGCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Code",0))
  1. .S COAGDESC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Description",0))
  1. .S COAGQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Qualifier",0))
  1. .S PROFSC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ProfessionalServiceCode",0))
  1. .S REACODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceReasonCode",0))
  1. .S RESCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceResultCode",0))
  1. .S CLQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"CodeListQualifier",0))
  1. .S QUOMCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"QuantityUnitOfMeasure",0,"Code",0))
  1. .S QUANTITY=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"Value",0))
  1. .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
  1. .; sequence, comp ingredient, comp ingredient item desc, item number code, item number qualifier
  1. .S INQUAL=$$PRESOLV^PSOERXA1(INQUAL,"ICQ") ; resolving pointer
  1. .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=COMPID,FDA(SF,IENS,.03)=INCODE,FDA(SF,IENS,.04)=INQUAL
  1. .; strength value, strength form, strength unit of measure, dea schedule code
  1. .S STRFORM=$$PRESOLV^PSOERXA1(STRFORM,"NCI") ; resolving pointer
  1. .S STRUOMCD=$$PRESOLV^PSOERXA1(STRUOMCD,"NCI") ; resolving pointer
  1. .S DEA=$$PRESOLV^PSOERXA1(DEA,"NCI") ; resolving pointer
  1. .S FDA(SF,IENS,1.1)=STRVAL,FDA(SF,IENS,1.2)=STRFORM,FDA(SF,IENS,1.3)=STRUOMCD,FDA(SF,IENS,1.4)=DEA
  1. .; compound quantity , compound qual, compound quantity unit of measure
  1. .S CLQUAL=$$PRESOLV^PSOERXA1(CLQUAL,"QCQ") ; resolving pointer
  1. .S QUOMCODE=$$PRESOLV^PSOERXA1(QUOMCODE,"NCI") ; resolving pointer
  1. .S FDA(SF,IENS,2.1)=QUANTITY,FDA(SF,IENS,2.2)=CLQUAL,FDA(SF,IENS,2.3)=QUOMCODE
  1. .; service reason code, professional service code, service result code
  1. .S REACODE=$$PRESOLV^PSOERXA1(REACODE,"REA") ; resolving pointer
  1. .S PROFSC=$$PRESOLV^PSOERXA1(PROFSC,"PSC") ; resolving pointer
  1. .S RESCODE=$$PRESOLV^PSOERXA1(RESCODE,"RES") ; resolving pointer
  1. .S FDA(SF,IENS,3.1)=REACODE,FDA(SF,IENS,3.2)=PROFSC,FDA(SF,IENS,3.3)=RESCODE
  1. .; co-agent code, co-agent qualifier, clinical significance code, acknowledgement reason, co-agent description
  1. .S COAGQUAL=$$PRESOLV^PSOERXA1(COAGQUAL,"CAQ") ; resolving pointer
  1. .S FDA(SF,IENS,3.4)=COAGCODE,FDA(SF,IENS,3.5)=COAGQUAL,FDA(SF,IENS,3.6)=CLINSC,FDA(SF,IENS,3.7)=ACKREA,FDA(SF,IENS,4)=COAGDESC
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. S FNLCMPDF=$G(@CGL@("FinalCompoundPharmaceuticalDosageForm",0))
  1. S FNLCMPDF=$$PRESOLV^PSOERXA1(FNLCMPDF,"NCI")
  1. S FDA(52.49311,MIEN_","_ERXIEN_",",81)=FNLCMPDF D FILE^DIE(,"FDA") K FDA
  1. Q