Routine: PSOERXOI

PSOERXOI ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm

 ;;7.0;OUTPATIENT PHARMACY;**581,746**;DEC 1997;Build 106

SIG(GL,CNT,ERXIEN,MIEN) ;

 N SIGTEXT,SNOMED,FMTVER,SIGCFT,SIGDAT,F,IENS,SIGL

 S F=52.49311

 S IENS=MIEN_","_ERXIEN_","

 D GETS^DIQ(F,IENS,"9.1;9.2;15","E","SIGDAT")

 S SNOMED=$G(SIGDAT(F,IENS,9.1,"E"))

 S FMTVER=$G(SIGDAT(F,IENS,9.2,"E"))

 S SIGCFT=$G(SIGDAT(F,IENS,15,"E"))

 D C S @GL@(CNT,0)="<Sig>"

 S SIGTEXT=""

 S SIGL=0 F  S SIGL=$O(^PS(52.49,ERXIEN,311,MIEN,8,SIGL)) Q:'SIGL  D

 .S SIGTEXT=SIGTEXT_$G(^PS(52.49,ERXIEN,311,MIEN,8,SIGL,0))_" "

 S $E(SIGTEXT,$L(SIGTEXT))=""

 D BL(GL,.CNT,"SigText",SIGTEXT)

 D C S @GL@(CNT,0)="<CodeSystem>"

 D BL(GL,.CNT,"SNOMEDVersion",SNOMED),BL(GL,.CNT,"FMTVersion",FMTVER)

 D C S @GL@(CNT,0)="</CodeSystem>"

 D MEDINST^PSOERXOJ(GL,.CNT,ERXIEN,MIEN)

 D SIGI4USE(GL,.CNT,ERXIEN,MIEN)

 D SIGMDR(GL,.CNT,ERXIEN,MIEN)

 D BL(GL,.CNT,"ClarifyingFreeText",SIGCFT)

 D C S @GL@(CNT,0)="</Sig>"

 ; sig level maximum dose restriction

SIGMDR(GL,CNT,ERXIEN,MIEN) ;

 N MDRIEN,MDRIENS,MDRV,MDRDAT,F,MDRV1,RUC,RUQ,RUT,DVAL,DUC,DUQ,DUT,RFC,RFQ,RFT,CFTEXT

 S F=52.4931114

 I '$O(^PS(52.49,ERXIEN,311,MIEN,14,0)) Q

 S MDRIEN=0 F  S MDRIEN=$O(^PS(52.49,ERXIEN,311,MIEN,14,MDRIEN)) Q:'MDRIEN  D

 .K MDRDAT

 .S MDRIENS=MDRIEN_","_MIEN_","_ERXIEN_","

 .D GETS^DIQ(F,MDRIENS,"**","E","MDRDAT")

 .S MDRV1=$G(MDRDAT(F,MDRIENS,1,"E")),RUC=$G(MDRDAT(F,MDRIENS,2,"E")),RUQ=$G(MDRDAT(F,MDRIENS,3,"E")),RUT=$G(MDRDAT(F,MDRIENS,4,"E"))

 .S DVAL=$G(MDRDAT(F,MDRIENS,5,"E")),DUC=$G(MDRDAT(F,MDRIENS,6,"E")),DUQ=$G(MDRDAT(F,MDRIENS,7,"E")),DUT=$G(MDRDAT(F,MDRIENS,8,"E"))

 .S RFC=$G(MDRDAT(F,MDRIENS,9,"E")),RFQ=$G(MDRDAT(F,MDRIENS,10,"E")),RFT=$G(MDRDAT(F,MDRIENS,11,"E"))

 .S CFTEXT=$G(MDRDAT(F,MDRIENS,12,"E"))

 .D C S @GL@(CNT,0)="<MaximumDoseRestriction>"

 .D BL(.GL,.CNT,"MaximumDoseRestrictionNumericValue",MDRV1)

 .D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionForm",RFT,RFQ,RFC)

 .D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionUnits",RUT,RUQ,RUC)

 .D BL(.GL,.CNT,"MaximumDoseRestrictionDurationValue",DVAL)

 .D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionDurationUnit",DUT,DUQ,DUC)

 .D BL(.GL,.CNT,"MaximumDoseRestrictionClarifyingFreeText",CFTEXT)

 .D C S @GL@(CNT,0)="</MaximumDoseRestriction>"

 ; indication for use at the sig level (medication prescribed)

SIGI4USE(GL,CNT,ERXIEN,MIEN) ;

 N F,IFUIEN,IFUIENS,IFUDAT,IPC,IPQ,IPT,IC,IQ,IT,IVC1,IVQ1,IVT1,IVM,IVC2,IVQ2,IVT2,IVUC,IVUQ,IVUT

 N IUOMC,IUOMQ,IUOMT

 S F=52.4931113

 ; dont build anything if the subscript is missing

 Q:'$O(^PS(52.49,ERXIEN,311,MIEN,13,0))

 S IFUIEN=0,IFUIEN=$O(^PS(52.49,ERXIEN,311,MIEN,13,IFUIEN)) Q:'IFUIEN  D

 .K IFUDAT

 .S IFUIENS=IFUIEN_","_MIEN_","_ERXIEN_","

 .D C S @GL@(CNT,0)="<IndicationForUse>"

 .D GETS^DIQ(F,IFUIENS,"**","E","IFUDAT")

 .S IPC=$G(IFUDAT(F,IFUIENS,1,"E")),IPQ=$G(IFUDAT(F,IFUIENS,2,"E")),IPT=$G(IFUDAT(F,IFUIENS,3,"E"))

 .S IC=$G(IFUDAT(F,IFUIENS,4,"E")),IQ=$G(IFUDAT(F,IFUIENS,5,"E")),IT=$G(IFUDAT(F,IFUIENS,6,"E"))

 .S IVC1=$G(IFUDAT(F,IFUIENS,7,"E")),IVQ1=$G(IFUDAT(F,IFUIENS,8,"E")),IVT1=$G(IFUDAT(F,IFUIENS,9,"E"))

 .S IVM=$G(IFUDAT(F,IFUIENS,10,"E"))

 .S IVC2=$G(IFUDAT(F,IFUIENS,11,"E")),IVQ2=$G(IFUDAT(F,IFUIENS,12,"E")),IVT2=$G(IFUDAT(F,IFUIENS,13,"E"))

 .S IVUC=$G(IFUDAT(F,IFUIENS,14,"E")),IVUQ=$G(IFUDAT(F,IFUIENS,15,"E")),IVUT=$G(IFUDAT(F,IFUIENS,16,"E"))

 .S IUOMC=$G(IFUDAT(F,IFUIENS,17,"E")),IUOMQ=$G(IFUDAT(F,IFUIENS,18,"E")),IUOMT=$G(IFUDAT(F,IFUIENS,19,"E"))

 .D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationPrescursor",IPT,IPQ,IPC)

 .D SIGTYPE^PSOERXOU(GL,.CNT,"Indication",IT,IQ,IC)

 .D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT1,IVQ1,IVC1)

 .I $L(IVM) D BL(GL,.CNT,"IndicationVariableModifier",IVM)

 .D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT2,IVQ2,IVC2)

 .D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnit",IVUT,IVUQ,IVUC)

 .D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnitOfMeasure",IUOMT,IUOMQ,IUOMC)

 D C S @GL@(CNT,0)="</IndicationForUse>"

BL(GBL,CNT,TAG,VAR) ;

 Q:VAR=""

 D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"

C ;

 S CNT=$G(CNT)+1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOI   4149     printed  Feb 18, 2025@23:55:20                                                                                                                                                                                                    Page 2

PSOERXOI  ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**581,746**;DEC 1997;Build 106

 +2       ;

 +3        QUIT

SIG(GL,CNT,ERXIEN,MIEN) ;

 +1        NEW SIGTEXT,SNOMED,FMTVER,SIGCFT,SIGDAT,F,IENS,SIGL

 +2        SET F=52.49311

 +3        SET IENS=MIEN_","_ERXIEN_","

 +4        DO GETS^DIQ(F,IENS,"9.1;9.2;15","E","SIGDAT")

 +5        SET SNOMED=$GET(SIGDAT(F,IENS,9.1,"E"))

 +6        SET FMTVER=$GET(SIGDAT(F,IENS,9.2,"E"))

 +7        SET SIGCFT=$GET(SIGDAT(F,IENS,15,"E"))

 +8        DO C

           SET @GL@(CNT,0)="<Sig>"

 +9        SET SIGTEXT=""

 +10       SET SIGL=0

FOR

               SET SIGL=$ORDER(^PS(52.49,ERXIEN,311,MIEN,8,SIGL))

               if 'SIGL

                   QUIT

               Begin DoDot:1

 +11               SET SIGTEXT=SIGTEXT_$GET(^PS(52.49,ERXIEN,311,MIEN,8,SIGL,0))_" "

               End DoDot:1

 +12       SET $EXTRACT(SIGTEXT,$LENGTH(SIGTEXT))=""

 +13       DO BL(GL,.CNT,"SigText",SIGTEXT)

 +14       DO C

           SET @GL@(CNT,0)="<CodeSystem>"

 +15       DO BL(GL,.CNT,"SNOMEDVersion",SNOMED)

           DO BL(GL,.CNT,"FMTVersion",FMTVER)

 +16       DO C

           SET @GL@(CNT,0)="</CodeSystem>"

 +17       DO MEDINST^PSOERXOJ(GL,.CNT,ERXIEN,MIEN)

 +18       DO SIGI4USE(GL,.CNT,ERXIEN,MIEN)

 +19       DO SIGMDR(GL,.CNT,ERXIEN,MIEN)

 +20       DO BL(GL,.CNT,"ClarifyingFreeText",SIGCFT)

 +21       DO C

           SET @GL@(CNT,0)="</Sig>"

 +22       QUIT

 +23      ; sig level maximum dose restriction

SIGMDR(GL,CNT,ERXIEN,MIEN) ;

 +1        NEW MDRIEN,MDRIENS,MDRV,MDRDAT,F,MDRV1,RUC,RUQ,RUT,DVAL,DUC,DUQ,DUT,RFC,RFQ,RFT,CFTEXT

 +2        SET F=52.4931114

 +3        IF '$ORDER(^PS(52.49,ERXIEN,311,MIEN,14,0))

               QUIT

 +4        SET MDRIEN=0

FOR

               SET MDRIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,14,MDRIEN))

               if 'MDRIEN

                   QUIT

               Begin DoDot:1

 +5                KILL MDRDAT

 +6                SET MDRIENS=MDRIEN_","_MIEN_","_ERXIEN_","

 +7                DO GETS^DIQ(F,MDRIENS,"**","E","MDRDAT")

 +8                SET MDRV1=$GET(MDRDAT(F,MDRIENS,1,"E"))

                   SET RUC=$GET(MDRDAT(F,MDRIENS,2,"E"))

                   SET RUQ=$GET(MDRDAT(F,MDRIENS,3,"E"))

                   SET RUT=$GET(MDRDAT(F,MDRIENS,4,"E"))

 +9                SET DVAL=$GET(MDRDAT(F,MDRIENS,5,"E"))

                   SET DUC=$GET(MDRDAT(F,MDRIENS,6,"E"))

                   SET DUQ=$GET(MDRDAT(F,MDRIENS,7,"E"))

                   SET DUT=$GET(MDRDAT(F,MDRIENS,8,"E"))

 +10               SET RFC=$GET(MDRDAT(F,MDRIENS,9,"E"))

                   SET RFQ=$GET(MDRDAT(F,MDRIENS,10,"E"))

                   SET RFT=$GET(MDRDAT(F,MDRIENS,11,"E"))

 +11               SET CFTEXT=$GET(MDRDAT(F,MDRIENS,12,"E"))

 +12               DO C

                   SET @GL@(CNT,0)="<MaximumDoseRestriction>"

 +13               DO BL(.GL,.CNT,"MaximumDoseRestrictionNumericValue",MDRV1)

 +14               DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionForm",RFT,RFQ,RFC)

 +15               DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionUnits",RUT,RUQ,RUC)

 +16               DO BL(.GL,.CNT,"MaximumDoseRestrictionDurationValue",DVAL)

 +17               DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionDurationUnit",DUT,DUQ,DUC)

 +18               DO BL(.GL,.CNT,"MaximumDoseRestrictionClarifyingFreeText",CFTEXT)

 +19               DO C

                   SET @GL@(CNT,0)="</MaximumDoseRestriction>"

               End DoDot:1

 +20       QUIT

 +21      ; indication for use at the sig level (medication prescribed)

SIGI4USE(GL,CNT,ERXIEN,MIEN) ;

 +1        NEW F,IFUIEN,IFUIENS,IFUDAT,IPC,IPQ,IPT,IC,IQ,IT,IVC1,IVQ1,IVT1,IVM,IVC2,IVQ2,IVT2,IVUC,IVUQ,IVUT

 +2        NEW IUOMC,IUOMQ,IUOMT

 +3        SET F=52.4931113

 +4       ; dont build anything if the subscript is missing

 +5        if '$ORDER(^PS(52.49,ERXIEN,311,MIEN,13,0))

               QUIT

 +6        SET IFUIEN=0

           SET IFUIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,13,IFUIEN))

           if 'IFUIEN

               QUIT

           Begin DoDot:1

 +7            KILL IFUDAT

 +8            SET IFUIENS=IFUIEN_","_MIEN_","_ERXIEN_","

 +9            DO C

               SET @GL@(CNT,0)="<IndicationForUse>"

 +10           DO GETS^DIQ(F,IFUIENS,"**","E","IFUDAT")

 +11           SET IPC=$GET(IFUDAT(F,IFUIENS,1,"E"))

               SET IPQ=$GET(IFUDAT(F,IFUIENS,2,"E"))

               SET IPT=$GET(IFUDAT(F,IFUIENS,3,"E"))

 +12           SET IC=$GET(IFUDAT(F,IFUIENS,4,"E"))

               SET IQ=$GET(IFUDAT(F,IFUIENS,5,"E"))

               SET IT=$GET(IFUDAT(F,IFUIENS,6,"E"))

 +13           SET IVC1=$GET(IFUDAT(F,IFUIENS,7,"E"))

               SET IVQ1=$GET(IFUDAT(F,IFUIENS,8,"E"))

               SET IVT1=$GET(IFUDAT(F,IFUIENS,9,"E"))

 +14           SET IVM=$GET(IFUDAT(F,IFUIENS,10,"E"))

 +15           SET IVC2=$GET(IFUDAT(F,IFUIENS,11,"E"))

               SET IVQ2=$GET(IFUDAT(F,IFUIENS,12,"E"))

               SET IVT2=$GET(IFUDAT(F,IFUIENS,13,"E"))

 +16           SET IVUC=$GET(IFUDAT(F,IFUIENS,14,"E"))

               SET IVUQ=$GET(IFUDAT(F,IFUIENS,15,"E"))

               SET IVUT=$GET(IFUDAT(F,IFUIENS,16,"E"))

 +17           SET IUOMC=$GET(IFUDAT(F,IFUIENS,17,"E"))

               SET IUOMQ=$GET(IFUDAT(F,IFUIENS,18,"E"))

               SET IUOMT=$GET(IFUDAT(F,IFUIENS,19,"E"))

 +18           DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationPrescursor",IPT,IPQ,IPC)

 +19           DO SIGTYPE^PSOERXOU(GL,.CNT,"Indication",IT,IQ,IC)

 +20           DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT1,IVQ1,IVC1)

 +21           IF $LENGTH(IVM)

                   DO BL(GL,.CNT,"IndicationVariableModifier",IVM)

 +22           DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT2,IVQ2,IVC2)

 +23           DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnit",IVUT,IVUQ,IVUC)

 +24           DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnitOfMeasure",IUOMT,IUOMQ,IUOMC)

           End DoDot:1

 +25       DO C

           SET @GL@(CNT,0)="</IndicationForUse>"

 +26       QUIT

BL(GBL,CNT,TAG,VAR) ;

 +1        if VAR=""

               QUIT

 +2        DO C

           SET @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"

 +3        QUIT

C         ;

 +1        SET CNT=$GET(CNT)+1

 +2        QUIT

PSOERXOI.m