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