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

PSOERXOM.m

Go to the documentation of this file. 
  1. PSOERXOM ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
  1.  ;
  1.  Q
  1.  ;
  1. OOTHMEDT(GL,CNT,ERXIEN,MIEN) ; OtherMedicationDate
  1.  N DATE,F,OMDDAT,OMDIEN,OMDIENS,QUAL
  1.  S F=52.4931162
  1.  S OMDIEN=0 F  S OMDIEN=$O(^PS(52.49,ERXIEN,311,MIEN,62,OMDIEN)) Q:'OMDIEN  D
  1.  .K OMDDAT
  1.  .S OMDIENS=OMDIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,OMDIENS,"**","I","OMDDAT")
  1.  .S DATE=$G(OMDDAT(F,OMDIENS,.02,"I")) S:DATE]"" DATE=$$EXTIME^PSOERXO1(DATE)
  1.  .S QUAL=$G(OMDDAT(F,OMDIENS,.03,"I"))
  1.  .I DATE'="",QUAL'="" D
  1.  ..D C S @GL@(CNT,0)="<OtherMedicationDate>"
  1.  ..D C S @GL@(CNT,0)="<OtherMedicationDate>"
  1.  ..D C S @GL@(CNT,0)="<DateTime>"_DATE_"</DateTime>"
  1.  ..D C S @GL@(CNT,0)="</OtherMedicationDate>"
  1.  ..D C S @GL@(CNT,0)="<OtherMedicationDateQualifier>"_QUAL_"</OtherMedicationDateQualifier>"
  1.  ..D C S @GL@(CNT,0)="</OtherMedicationDate>"
  1.  Q
  1.  ;
  1. OFACSPE(GL,CNT,ERXIEN,MIEN) ; FacilitySpecificHoursOfAdministrationTiming
  1.  N CODE,F,FIELD,I,OFSDAT,OFSIEN,OFSIENS,QUAL,TEXT,VALUE,VAR
  1.  S F=52.4931161
  1.  S OFSIEN=0 F  S OFSIEN=$O(^PS(52.49,ERXIEN,311,MIEN,61,OFSIEN)) Q:'OFSIEN  D
  1.  .K OFSDAT
  1.  .S OFSIENS=OFSIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,OFSIENS,"**","E","OFSDAT")
  1.  .F I=".02,VALUE","1,TEXT","2.1,QUAL","2.2,CODE" D
  1.  ..S FIELD=$P(I,","),VAR=$P(I,",",2)
  1.  ..S @VAR=$G(OFSDAT(F,OFSIENS,FIELD,"E"))
  1.  .I VALUE'="",TEXT'="",QUAL'="",CODE'="" D
  1.  ..D C S @GL@(CNT,0)="<FacilitySpecificHoursOfAdministrationTiming>"
  1.  ..D C S @GL@(CNT,0)="<HoursOfAdministrationValue>"_VALUE_"</HoursOfAdministrationValue>"
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"HoursOfAdministration",TEXT,QUAL,CODE)
  1.  ..D C S @GL@(CNT,0)="</FacilitySpecificHoursOfAdministrationTiming>"
  1.  Q
  1.  ; 
  1. OPTCODNT(GL,CNT,ERXIEN,MIEN) ; PatientCodifiedNote
  1.  N F,PCNDAT,PCNIEN,PCNIENS,QUAL,VALUE
  1.  S F=52.4931159
  1.  S PCNIEN=0 F  S PCNIEN=$O(^PS(52.49,ERXIEN,311,MIEN,59,PCNIEN)) Q:'PCNIEN  D
  1.  .K PCNDAT
  1.  .S PCNIENS=PCNIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,PCNIENS,"**","E","PCNDAT")
  1.  .S QUAL=$G(PCNDAT(F,PCNIENS,.02,"E"))
  1.  .S VALUE=$G(PCNDAT(F,PCNIENS,.03,"E"))
  1.  .I QUAL'="" D
  1.  ..D C S @GL@(CNT,0)="<PatientCodifiedNote>"
  1.  ..D C S @GL@(CNT,0)="<Qualifier>"_QUAL_"</Qualifier>"
  1.  ..D BL(GL,.CNT,"Value",VALUE)
  1.  ..D C S @GL@(CNT,0)="</PatientCodifiedNote>"
  1.  Q
  1.  ; 
  1. OCOMPINF(GL,CNT,ERXIEN,MIEN) ; CompoundInformation
  1.  N ACKRSN,CIDAT,CIIEN,CIIENS,CLSIGCD,COAGCODE,COAGDESC,COAGQUAL,COPHDOFM,CQCODQL,CQUOM,CQVAL
  1.  N DEACODE,DESC,F,FIELD,I,J,NRCODE,NRQUAL,PRSVCD,STRFORM,STRUOM,STRVAL,SVRSLTCD,SVRSNCD,VAR
  1.  S F=52.49311
  1.  S CIIENS=MIEN_","_ERXIEN_","
  1.  D GETS^DIQ(F,CIIENS,56.1,"E","CIDAT")
  1.  S COPHDOFM=$G(CIDAT(F,CIIENS,56.1,"E"))
  1.  K CIDAT S F=52.4931157
  1.  S CIIEN=0 F  S CIIEN=$O(^PS(52.49,ERXIEN,311,MIEN,57,CIIEN)) Q:'CIIEN  D
  1.  .K CIDAT
  1.  .S CIIENS=CIIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,CIIENS,"**","E","CIDAT")
  1.  .F I=1:1 S TXT=$P($T(COMPINFD+I),";;",2) Q:TXT="DONE"  D
  1.  ..F J=1:1:$L(TXT,";") D
  1.  ...S FIELD=$P(TXT,";",J),VAR=$P(FIELD,",",2),FIELD=$P(FIELD,",")
  1.  ...S @VAR=$G(CIDAT(F,CIIENS,FIELD,"E"))
  1.  .I COPHDOFM'="",CQVAL'="",CQCODQL'="",CQUOM'="" D
  1.  ..D C S @GL@(CNT,0)="<CompoundInformation>"
  1.  ..D C S @GL@(CNT,0)="<FinalCompoundPharmaceuticalDosageForm>"_COPHDOFM_"</FinalCompoundPharmaceuticalDosageForm>"
  1.  ..D C S @GL@(CNT,0)="<CompoundIngredientsLotNotUsed>"
  1.  ..I DESC'="" D
  1.  ...D C S @GL@(CNT,0)="<CompoundIngredient>"
  1.  ...D C S @GL@(CNT,0)="<CompoundIngredientItemDescription>"_DESC_"</CompoundIngredientItemDescription>"
  1.  ...I NRCODE'="",NRQUAL'="" D
  1.  ....D C S @GL@(CNT,0)="<ItemNumber>"
  1.  ....D C S @GL@(CNT,0)="<Code>"_NRCODE_"</Code>"
  1.  ....D C S @GL@(CNT,0)="<Qualifier>"_NRQUAL_"</Qualifier>"
  1.  ....D C S @GL@(CNT,0)="</ItemNumber>"
  1.  ...I $L(STRVAL_STRFORM_STRUOM) D
  1.  ....D C S @GL@(CNT,0)="<Strength>"
  1.  ....D BL(GL,.CNT,"StrengthValue",STRVAL)
  1.  ....D BL(GL,.CNT,"StrengthForm",STRFORM)
  1.  ....D BL(GL,.CNT,"StrengthUnitOfMeasure",STRUOM)
  1.  ....D C S @GL@(CNT,0)="</Strength>"
  1.  ...I DEACODE'="" D
  1.  ....D C S @GL@(CNT,0)="<DEASchedule>"
  1.  ....D C S @GL@(CNT,0)="<Code>"_DEACODE_"</Code>"
  1.  ....D C S @GL@(CNT,0)="</DEASchedule>"
  1.  ...D C S @GL@(CNT,0)="</CompoundIngredient>"
  1.  ..D
  1.  ...D C S @GL@(CNT,0)="<Quantity>"
  1.  ...D C S @GL@(CNT,0)="<Value>"_CQVAL_"</Value>"
  1.  ...D C S @GL@(CNT,0)="<CodeListQualifier>"_CQCODQL_"</CodeListQualifier>"
  1.  ...D C S @GL@(CNT,0)="<QuantityUnitOfMeasure>"
  1.  ...D C S @GL@(CNT,0)="<Code>"_CQUOM_"</Code>"
  1.  ...D C S @GL@(CNT,0)="</QuantityUnitOfMeasure>"
  1.  ...D C S @GL@(CNT,0)="</Quantity>"
  1.  ..I SVRSNCD'="" D
  1.  ...D C S @GL@(CNT,0)="<DrugUseEvaluation>"
  1.  ...D C S @GL@(CNT,0)="<ServiceReasonCode>"_SVRSNCD_"</ServiceReasonCode>"
  1.  ...D BL(GL,.CNT,"ProfessionalServiceCode",PRSVCD)
  1.  ...D BL(GL,.CNT,"ServiceResultCode",SVRSLTCD)
  1.  ...I COAGCODE'="",COAGQUAL'="",COAGDESC'="" D
  1.  ....D C S @GL@(CNT,0)="<CoAgent>"
  1.  ....D C S @GL@(CNT,0)="<CoAgentCode>"
  1.  ....D C S @GL@(CNT,0)="<Code>"_COAGCODE_"</Code>"
  1.  ....D C S @GL@(CNT,0)="<Qualifier>"_COAGQUAL_"</Qualifier>"
  1.  ....D C S @GL@(CNT,0)="<Description>"_COAGDESC_"</Description>"
  1.  ....D C S @GL@(CNT,0)="</CoAgentCode>"
  1.  ....D C S @GL@(CNT,0)="</CoAgent>"
  1.  ...D BL(GL,.CNT,"ClinicalSignificanceCode",CLSIGCD)
  1.  ...D BL(GL,.CNT,"AcknowledgementReason",ACKRSN)
  1.  ...D C S @GL@(CNT,0)="</DrugUseEvaluation>"
  1.  ..D C S @GL@(CNT,0)="</CompoundIngredientsLotNotUsed>"
  1.  ..D C S @GL@(CNT,0)="<CompoundInformation>"
  1.  ..D FIX(.GL,.CNT)
  1.  Q
  1.  ;
  1. COMPINFD ;; For each field in ; fields - Field#,Variable
  1.  ;;.02,DESC;.03,NRCODE;.04,NRQUAL;1.1,STRVAL;1.2,STRFORM;1.3,STRUOM;1.4,DEACODE
  1.  ;;2.1,CQVAL;2.2,CQCODQL;2.3,CQUOM;3.1,SVRSNCD;3.2,PRSVCD;3.3,SVRSLTCD;3.4,COAGCODE;3.5,COAGQUAL
  1.  ;;3.6,CLSIGCD;3.7,ACKRSN;4,COAGDESC
  1.  ;;DONE
  1.  ;
  1. OTITDSMS(GL,CNT,ERXIEN,MIEN) ; Titration
  1.  N ADTIVA,F,FIELD,I,J,LOINVERS,MAMEVA,MEASNOTE,MEDUCLTE,MEDUCO,MEDUQU,MEDUTE,MEDUTRCO
  1.  N MEDUTRQU,MEDUTRTE,MEDUVA,MEFRNUVA,MEFRUNCO,MEFRUNQU,MEFRUNTE,MEINMO,MEINNUV1
  1.  N MEINUNCO,MEINUNQU,MEINUNTE,METICLTE,METIEVCO,METIEVQU,METIEVTE,METIMOCO,METIMOQU
  1.  N METIMOTE,METIUNCO,METIUNQU,METIUNTE,METIVA,MEVAFRMO,MFNV2,MIENS,MIMEVA,MINV2
  1.  N PHTOTRDO,TDIEN,TDIENS,TXT,UCUMVERS,UNOFME,VALUE,VAMETIMO,VAR,VITASIGN
  1.  S F=52.49311
  1.  S MIENS=MIEN_","_ERXIEN_","
  1.  D GETS^DIQ(F,MIENS,49.1,"E","TDDAT")
  1.  S PHTOTRDO=$G(TDDAT(F,MIENS,49.1,"E"))
  1.  S F=52.4931151
  1.  S TDIEN=0 F  S TDIEN=$O(^PS(52.49,ERXIEN,311,MIEN,51,TDIEN)) Q:'TDIEN  D
  1.  .K TDDAT
  1.  .S TDIENS=TDIEN_","_MIEN_","_ERXIEN_","
  1.  .D GETS^DIQ(F,TDIENS,"**","E","TDDAT")
  1.  .F I=1:1 S TXT=$P($T(OTITDSMD+I),";;",2) Q:TXT="DONE"  D
  1.  ..F J=1:1:$L(TXT,";") D
  1.  ...S FIELD=$P(TXT,";",J),VAR=$P(FIELD,",",2),FIELD=$P(FIELD,",")
  1.  ...S @VAR=$G(TDDAT(F,TDIENS,FIELD,"E"))
  1.  .D C S @GL@(CNT,0)="<Titration>"
  1.  .D BL(GL,.CNT,"PharmacyToTitrateDose",PHTOTRDO)
  1.  .D C S @GL@(CNT,0)="<TitrationDose>"
  1.  .I VITASIGN'="",LOINVERS'="",VALUE'="",UNOFME'="",UCUMVERS'="" D
  1.  ..D C S @GL@(CNT,0)="<Measurement>"
  1.  ..D C S @GL@(CNT,0)="<VitalSign>"_VITASIGN_"</VitalSign>"
  1.  ..D C S @GL@(CNT,0)="<LOINCVersion>"_LOINVERS_"</LOINCVersion>"
  1.  ..D C S @GL@(CNT,0)="<Value>"_VALUE_"</Value>"
  1.  ..D C S @GL@(CNT,0)="<UnitOfMeasure>"_UNOFME_"</UnitOfMeasure>"
  1.  ..D C S @GL@(CNT,0)="<UCUMVersion>"_UCUMVERS_"</UCUMVersion>"
  1.  ..D BL(GL,.CNT,"MinimumMeasurementValue",MIMEVA)
  1.  ..D BL(GL,.CNT,"MaximumMeasurementValue",MAMEVA)
  1.  ..D BL(GL,.CNT,"MeasurementNotes",MEASNOTE)
  1.  ..D C S @GL@(CNT,0)="</Measurement>"
  1.  .D C S @GL@(CNT,0)="<MeasurementTimingAndDuration>"
  1.  .D C S @GL@(CNT,0)="<MeasurementAdministrationTiming>"
  1.  .I METIVA'="",VAMETIMO'="",METIUNTE'="",METIUNQU'="",METIUNCO'="" D  ; Sequence
  1.  ..D C S @GL@(CNT,0)="<MeasurementTimingNumericValue>"_METIVA_"</MeasurementTimingNumericValue>"
  1.  ..D C S @GL@(CNT,0)="<VariableMeasurementTimingModifier>"_VAMETIMO_"</VariableMeasurementTimingModifier>"
  1.  ..D BL(GL,.CNT,"AdministrationTimingNumericValue",ADTIVA)
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementTimingUnits",METIUNTE,METIUNQU,METIUNCO)
  1.  .I METIMOTE'="",METIMOQU'="",METIMOCO'="" D
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementTimingModifier",METIMOTE,METIMOQU,METIMOCO)
  1.  .I METIEVTE'="",METIEVQU'="",METIEVCO'="" D
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementTimingEvent",METIEVTE,METIEVQU,METIEVCO)
  1.  .D BL(GL,.CNT,"MeasurementTimingClarifyingFreeText",METICLTE)
  1.  .D C S @GL@(CNT,0)="</MeasurementAdministrationTiming>"
  1.  .I MEFRNUVA'="",MEFRUNTE'="",MEFRUNQU'="",MEFRUNCO'="" D
  1.  ..D C S @GL@(CNT,0)="<MeasurementFrequency>"
  1.  ..D C S @GL@(CNT,0)="<MeasurementFrequencyNumericValue>"_MEFRNUVA_"</MeasurementFrequencyNumericValue>"
  1.  ..I MEVAFRMO'="",MFNV2'="" D  ; Sequence
  1.  ...D BL(GL,.CNT,"MeasurementVariableFrequencyModifier",MEVAFRMO)
  1.  ..D BL(GL,.CNT,"MeasurementFrequencyNumericValue",MFNV2)
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementFrequencyUnits",MEFRUNTE,MEFRUNQU,MEFRUNCO)
  1.  ..D C S @GL@(CNT,0)="</MeasurementFrequency>"
  1.  .I MEINNUV1'="",MEINUNTE'="",MEINUNQU'="",MEINUNCO'="" D
  1.  ..D C S @GL@(CNT,0)="<MeasurementInterval>"
  1.  ..D C S @GL@(CNT,0)="<MeasurementIntervalNumericValue>"_MEINNUV1_"</MeasurementIntervalNumericValue>"
  1.  ..I MEINMO'="",MINV2'="" D  ; Sequence
  1.  ...D C S @GL@(CNT,0)="<MeasurementVariableIntervalModifier>"_MEINMO_"</MeasurementVariableIntervalModifier>"
  1.  ...D C S @GL@(CNT,0)="<MeasurementIntervalNumericValue>"_MINV2_"</MeasurementIntervalNumericValue>"
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementIntervalUnits",MEINUNTE,MEINUNQU,MEINUNCO)
  1.  ..D C S @GL@(CNT,0)="</MeasurementInterval>"
  1.  .I MEDUVA'="",MEDUTE'="",MEDUQU'="",MEDUCO'="" D
  1.  ..D C S @GL@(CNT,0)="<MeasurementDuration>"
  1.  ..D C S @GL@(CNT,0)="<MeasurementDurationNumericValue>"_MEDUVA_"</MeasurementDurationNumericValue>"
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementDurationText",MEDUTE,MEDUQU,MEDUCO)
  1.  ..D C S @GL@(CNT,0)="</MeasurementDuration>"
  1.  .I MEDUTRTE'="",MEDUTRQU'="",MEDUTRCO'="" D
  1.  ..D C S @GL@(CNT,0)="<MeasurementDurationTrigger>"
  1.  ..D SIGTYPE^PSOERXOU(.GL,.CNT,"MeasurementTrigger",MEDUTRTE,MEDUTRQU,MEDUTRCO)
  1.  ..D BL(GL,.CNT,"MeasurementDurationClarifyingFreeText",MEDUCLTE)
  1.  ..D C S @GL@(CNT,0)="</MeasurementDurationTrigger>"
  1.  .D C S @GL@(CNT,0)="</MeasurementTimingAndDuration>"
  1.  .D C S @GL@(CNT,0)="</TitrationDose>"
  1.  .D C S @GL@(CNT,0)="</Titration>"
  1.  .D FIX(.GL,.CNT)
  1.  Q
  1.  ;
  1. OTITDSMD ;; For each field in ; fields - Field#,Variable
  1.  ;;1,VITASIGN;2,LOINVERS;3,VALUE;4,UNOFME;5.1,MIMEVA;5.2,MAMEVA;6,MEASNOTE;7.1,METIVA
  1.  ;;7.2,VAMETIMO;7.3,ADTIVA;8,METIUNTE;9,METIUNQU;10,METIUNCO;11,METIMOTE;12,METIMOQU;13,METIMOCO
  1.  ;;14,METIEVTE;15,METIEVQU;16,METIEVCO;17,METICLTE;18.1,MEFRNUVA;18.2,MEVAFRMO;18.3,MFNV2
  1.  ;;19,MEFRUNTE;20,MEFRUNQU;21,MEFRUNCO;22.1,MEINNUV1;22.2,MEINMO;22.3,MINV2;23,MEINUNTE
  1.  ;;24,MEINUNQU;25,MEINUNCO;26,MEDUVA;27,MEDUTE;28,MEDUQU;29,MEDUCO;30,MEDUTRTE;31,MEDUTRQU
  1.  ;;32,MEDUTRCO;33,MEDUCLTE;34,UCUMVERS
  1.  ;;DONE
  1.  ;
  1. BL(GBL,CNT,TAG,VAR) ;
  1.  Q:VAR=""
  1.  D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
  1.  Q
  1.  ;
  1. C ;
  1.  S CNT=$G(CNT)+1
  1.  Q
  1.  ;
  1. FIX(GL,CNT) ; Remove empty structures
  1.  N FLG,GL2,I,TXT,TXT2
  1.  F  D  Q:'FLG  ; Keep removing empty structures until there are no more
  1.  .S FLG=0
  1.  .F I=1:1:CNT-1 D
  1.  ..S TXT=@GL@(I,0),TXT2=$G(@GL@(I+1,0))
  1.  ..I TXT2=("</"_$E(TXT,2,$L(TXT))) D
  1.  ...K @GL@(I),@GL@(I+1)
  1.  ...S FLG=1,I=I+1
  1.  .I FLG D
  1.  ..S GL2=0,I=""
  1.  ..F  S I=$O(@GL@(I)) Q:I=""  D
  1.  ...;/JSG/ PSO*7.0*581 - BEGIN CHANGE (Remove $I)
  1.  ...S TXT=@GL@(I,0),GL2=GL2+1,GL2(GL2,0)=TXT
  1.  ...;/JSG/ - END CHANGE
  1.  ..S CNT=GL2
  1.  ..K @GL M @GL=GL2 K GL2
  1.  Q