Routine: PSOERXOF

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

 ;;7.0;OUTPATIENT PHARMACY;**581,635**;DEC 1997;Build 19

 ; REFREQ - # of refills requested (rxrenewal request messages).

MEDDIS(GBL,CNT,PSOIEN,RXIEN,ORIEN,REFREQ) ;

 N DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,VALUE,CLQUAL,USCODE,PUC,DAYSUPP

 N F,DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,SIGTXT,SIGLOOP

 N RXDAT,RXIENS,DRUGDES,QTY,RXDAT,RVAL,DRUGIEN,DNDC,SUBST,LESS,I,DCLOOP,DCSVAL,MEDIEN,QUOM,CLQUAL

 N ERXSFIEN,MTYPE,RESVAL,NODE,ORIGQTY

 ; this is the section we will likely be using

 S RXIENS=RXIEN_","

 S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I"),RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")

 D GETS^DIQ(52,RXIENS,"1;6;7;8;9;10;10.2;101","IE","RXDAT")

 D CONVXML^PSOERXX1("RXDAT")

 S DRUGDES=$G(RXDAT(52,RXIENS,6,"E"))

 S DRUGIEN=$G(RXDAT(52,RXIENS,6,"I"))

 ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707

 I DRUGIEN S DNDC=$$GETNDC^PSSNDCUT(DRUGIEN,$G(PSOSITE)),DNDC=$TR(DNDC,"-","")

 S QTY=$G(RXDAT(52,RXIENS,7,"E"))

 I QTY[".",$P(QTY,".",2)="" S QTY=$P(QTY,".")

 ;38 Original Quantity

 ;40 Remaining Quantity

 ;87 Quantity Received

 ;QS Quantity sufficient as determined by the dispensing pharmacy.

 ;   Quantity to be based on established dispensing protocols between

 ;   the prescriber and pharmacy/pharmacist.

 ; FUTURE - WHEN THIS IS USED, CLQUAL MAY NEED TO BE CALCULATED AND NOT HARD CODED

 S NODE=$S(MTYPE="N":"P",(MTYPE="RE"):"MR",1:"P")

 S ERXSFIEN=$O(^PS(52.49,PSOIEN,311,"C",NODE,0))

 ; PSO*7*635 - if the original quantity does not match the dispense quantity, return 'Unspecified - C38046'

 S ORIGQTY=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.1,"E")

 S CLQUAL=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.2,"E")

 I ORIGQTY=QTY S QUOM=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.3,"E")

 I ORIGQTY'=QTY S QUOM="C38046"

 ; PSO*7*635 - end fix

 ; how to determine Unit Source Code?

 ;AA - NCI values of Diagnostic, Therapeutic, and Research Equipment - Pharmaceutical Dosage Form (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 ;AB - NCI values of Units of Presentation (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 ;AC - NCI values of Property or Attribute - Unit of Measure - Unit of Category - Potency Unit (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 ; FOR NOW SET IT TO AA

 S USCODE="AA"

 S DAYSUPP=$G(RXDAT(52,RXIENS,8,"E"))

 ; DIRECTIONS COME FROM SIG, FIELD 10

 ; FUTURE ENHANCEMENT - SHOULD WE GRAB ALL INFORMATION FROM THE SIG1 MULTIPLE? 52,10.2

 S SIGLOOP=0 F  S SIGLOOP=$O(^PSRX(RXIEN,"SIG1",SIGLOOP)) Q:'SIGLOOP  D

 .I '$D(SIGTXT) S SIGTXT=$G(^PSRX(RXIEN,"SIG1",SIGLOOP,0)) Q

 .S SIGTXT=SIGTXT_" "_$G(^PSRX(RXIEN,"SIG1",SIGLOOP,0))

 S SIGTXT=$$SYMENC^MXMLUTL(SIGTXT)

 S REQUAL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")

 I REQUAL="R" S REQUAL="P"

 S SUBST=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")

 S RVAL=$S($D(REFREQ):REFREQ,1:$G(RXDAT(52,RXIENS,9,"E")))

 I $D(REFREQ) S REQUAL="P"

 ; CONVERT DATE types, ALSO MAKE SURE WE NEED TO POPULATE THESE.. MAY NOT BE NEEDED

 S LFDATE=$G(RXDAT(52,RXIENS,101,"I")) I LFDATE S LFDATE=$P($$EXTIME^PSOERXO1(LFDATE),"T")

 S EXDATE=$G(RXDAT(52,RXIENS,26,"I")) I EXDATE S EXDATE=$P($$EXTIME^PSOERXO1(EXDATE),"T")

 S WDATE=$G(RXDAT(52,RXIENS,1,"I")) I WDATE S WDATE=$P($$EXTIME^PSOERXO1(WDATE),"T")

 S EFDATE=""

 D C S @GBL@(CNT,0)="<MedicationDispensed>"

 D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"

 I $L($G(DNDC)) D

 .D C S @GBL@(CNT,0)="<DrugCoded>"

 .D C S @GBL@(CNT,0)="<ProductCode>"

 .D BL(GBL,.CNT,"Code",DNDC)

 .D BL(GBL,.CNT,"Qualifier","ND")

 .D C S @GBL@(CNT,0)="</ProductCode>"

 .D C S @GBL@(CNT,0)="</DrugCoded>"

 D C S @GBL@(CNT,0)="<Quantity>"

 D C S @GBL@(CNT,0)="<Value>"_QTY_"</Value>"

 D C S @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"

 D C S @GBL@(CNT,0)="<QuantityUnitOfMeasure>"

 D BL(GBL,.CNT,"Code",QUOM)

 D C S @GBL@(CNT,0)="</QuantityUnitOfMeasure>"

 D C S @GBL@(CNT,0)="</Quantity>"

 D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"

 I $L(WDATE) D

 .D C S @GBL@(CNT,0)="<WrittenDate>"

 .D C S @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"

 .D C S @GBL@(CNT,0)="</WrittenDate>"

 I $L(LFDATE) D

 .D C S @GBL@(CNT,0)="<LastFillDate>"

 .D C S @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"

 .D C S @GBL@(CNT,0)="</LastFillDate>"

 I $L(SUBST) D C S @GBL@(CNT,0)="<Substitutions>"_SUBST_"</Substitutions>"

 S MEDIEN=$O(^PS(52.49,PSOIEN,311,0))

 S DCLOOP=0 F  S DCLOOP=$O(^PS(52.49,PSOIEN,311,MEDIEN,7,DCLOOP)) Q:'DCLOOP  D

 .S DCSVAL=$$GET1^DIQ(52.493117,DCLOOP_","_MEDIEN_","_PSOIEN_",",.02,"E")

 .D C S @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"

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

 D BL(GBL,.CNT,"SigText",SIGTXT)

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

 I $G(REFREQ) D BL(GBL,.CNT,"PharmacyRequestedRefills",REFREQ)

 D C S @GBL@(CNT,0)="</MedicationDispensed>"

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[HPSOERXOF   5179     printed  Mar 13, 2025@21:33:43                                                                                                                                                                                                    Page 2

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

 +1       ;;7.0;OUTPATIENT PHARMACY;**581,635**;DEC 1997;Build 19

 +2       ;

 +3        QUIT

 +4       ; REFREQ - # of refills requested (rxrenewal request messages).

MEDDIS(GBL,CNT,PSOIEN,RXIEN,ORIEN,REFREQ) ;

 +1        NEW DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,VALUE,CLQUAL,USCODE,PUC,DAYSUPP

 +2        NEW F,DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,SIGTXT,SIGLOOP

 +3        NEW RXDAT,RXIENS,DRUGDES,QTY,RXDAT,RVAL,DRUGIEN,DNDC,SUBST,LESS,I,DCLOOP,DCSVAL,MEDIEN,QUOM,CLQUAL

 +4        NEW ERXSFIEN,MTYPE,RESVAL,NODE,ORIGQTY

 +5       ; this is the section we will likely be using

 +6        SET RXIENS=RXIEN_","

 +7        SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")

           SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")

 +8        DO GETS^DIQ(52,RXIENS,"1;6;7;8;9;10;10.2;101","IE","RXDAT")

 +9        DO CONVXML^PSOERXX1("RXDAT")

 +10       SET DRUGDES=$GET(RXDAT(52,RXIENS,6,"E"))

 +11       SET DRUGIEN=$GET(RXDAT(52,RXIENS,6,"I"))

 +12      ;Reference to $$GETNDC^PSSNDCUT supported by IA 4707

 +13       IF DRUGIEN

               SET DNDC=$$GETNDC^PSSNDCUT(DRUGIEN,$GET(PSOSITE))

               SET DNDC=$TRANSLATE(DNDC,"-","")

 +14       SET QTY=$GET(RXDAT(52,RXIENS,7,"E"))

 +15       IF QTY["."

               IF $PIECE(QTY,".",2)=""

                   SET QTY=$PIECE(QTY,".")

 +16      ;38 Original Quantity

 +17      ;40 Remaining Quantity

 +18      ;87 Quantity Received

 +19      ;QS Quantity sufficient as determined by the dispensing pharmacy.

 +20      ;   Quantity to be based on established dispensing protocols between

 +21      ;   the prescriber and pharmacy/pharmacist.

 +22      ; FUTURE - WHEN THIS IS USED, CLQUAL MAY NEED TO BE CALCULATED AND NOT HARD CODED

 +23       SET NODE=$SELECT(MTYPE="N":"P",(MTYPE="RE"):"MR",1:"P")

 +24       SET ERXSFIEN=$ORDER(^PS(52.49,PSOIEN,311,"C",NODE,0))

 +25      ; PSO*7*635 - if the original quantity does not match the dispense quantity, return 'Unspecified - C38046'

 +26       SET ORIGQTY=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.1,"E")

 +27       SET CLQUAL=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.2,"E")

 +28       IF ORIGQTY=QTY

               SET QUOM=$$GET1^DIQ(52.49311,ERXSFIEN_","_PSOIEN_",",2.3,"E")

 +29       IF ORIGQTY'=QTY

               SET QUOM="C38046"

 +30      ; PSO*7*635 - end fix

 +31      ; how to determine Unit Source Code?

 +32      ;AA - NCI values of Diagnostic, Therapeutic, and Research Equipment - Pharmaceutical Dosage Form (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 +33      ;AB - NCI values of Units of Presentation (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 +34      ;AC - NCI values of Property or Attribute - Unit of Measure - Unit of Category - Potency Unit (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)

 +35      ; FOR NOW SET IT TO AA

 +36       SET USCODE="AA"

 +37       SET DAYSUPP=$GET(RXDAT(52,RXIENS,8,"E"))

 +38      ; DIRECTIONS COME FROM SIG, FIELD 10

 +39      ; FUTURE ENHANCEMENT - SHOULD WE GRAB ALL INFORMATION FROM THE SIG1 MULTIPLE? 52,10.2

 +40       SET SIGLOOP=0

FOR

               SET SIGLOOP=$ORDER(^PSRX(RXIEN,"SIG1",SIGLOOP))

               if 'SIGLOOP

                   QUIT

               Begin DoDot:1

 +41               IF '$DATA(SIGTXT)

                       SET SIGTXT=$GET(^PSRX(RXIEN,"SIG1",SIGLOOP,0))

                       QUIT

 +42               SET SIGTXT=SIGTXT_" "_$GET(^PSRX(RXIEN,"SIG1",SIGLOOP,0))

               End DoDot:1

 +43       SET SIGTXT=$$SYMENC^MXMLUTL(SIGTXT)

 +44       SET REQUAL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")

 +45       IF REQUAL="R"

               SET REQUAL="P"

 +46       SET SUBST=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")

 +47       SET RVAL=$SELECT($DATA(REFREQ):REFREQ,1:$GET(RXDAT(52,RXIENS,9,"E")))

 +48       IF $DATA(REFREQ)

               SET REQUAL="P"

 +49      ; CONVERT DATE types, ALSO MAKE SURE WE NEED TO POPULATE THESE.. MAY NOT BE NEEDED

 +50       SET LFDATE=$GET(RXDAT(52,RXIENS,101,"I"))

           IF LFDATE

               SET LFDATE=$PIECE($$EXTIME^PSOERXO1(LFDATE),"T")

 +51       SET EXDATE=$GET(RXDAT(52,RXIENS,26,"I"))

           IF EXDATE

               SET EXDATE=$PIECE($$EXTIME^PSOERXO1(EXDATE),"T")

 +52       SET WDATE=$GET(RXDAT(52,RXIENS,1,"I"))

           IF WDATE

               SET WDATE=$PIECE($$EXTIME^PSOERXO1(WDATE),"T")

 +53       SET EFDATE=""

 +54       DO C

           SET @GBL@(CNT,0)="<MedicationDispensed>"

 +55       DO C

           SET @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"

 +56       IF $LENGTH($GET(DNDC))

               Begin DoDot:1

 +57               DO C

                   SET @GBL@(CNT,0)="<DrugCoded>"

 +58               DO C

                   SET @GBL@(CNT,0)="<ProductCode>"

 +59               DO BL(GBL,.CNT,"Code",DNDC)

 +60               DO BL(GBL,.CNT,"Qualifier","ND")

 +61               DO C

                   SET @GBL@(CNT,0)="</ProductCode>"

 +62               DO C

                   SET @GBL@(CNT,0)="</DrugCoded>"

               End DoDot:1

 +63       DO C

           SET @GBL@(CNT,0)="<Quantity>"

 +64       DO C

           SET @GBL@(CNT,0)="<Value>"_QTY_"</Value>"

 +65       DO C

           SET @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"

 +66       DO C

           SET @GBL@(CNT,0)="<QuantityUnitOfMeasure>"

 +67       DO BL(GBL,.CNT,"Code",QUOM)

 +68       DO C

           SET @GBL@(CNT,0)="</QuantityUnitOfMeasure>"

 +69       DO C

           SET @GBL@(CNT,0)="</Quantity>"

 +70       DO C

           SET @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"

 +71       IF $LENGTH(WDATE)

               Begin DoDot:1

 +72               DO C

                   SET @GBL@(CNT,0)="<WrittenDate>"

 +73               DO C

                   SET @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"

 +74               DO C

                   SET @GBL@(CNT,0)="</WrittenDate>"

               End DoDot:1

 +75       IF $LENGTH(LFDATE)

               Begin DoDot:1

 +76               DO C

                   SET @GBL@(CNT,0)="<LastFillDate>"

 +77               DO C

                   SET @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"

 +78               DO C

                   SET @GBL@(CNT,0)="</LastFillDate>"

               End DoDot:1

 +79       IF $LENGTH(SUBST)

               DO C

               SET @GBL@(CNT,0)="<Substitutions>"_SUBST_"</Substitutions>"

 +80       SET MEDIEN=$ORDER(^PS(52.49,PSOIEN,311,0))

 +81       SET DCLOOP=0

FOR

               SET DCLOOP=$ORDER(^PS(52.49,PSOIEN,311,MEDIEN,7,DCLOOP))

               if 'DCLOOP

                   QUIT

               Begin DoDot:1

 +82               SET DCSVAL=$$GET1^DIQ(52.493117,DCLOOP_","_MEDIEN_","_PSOIEN_",",.02,"E")

 +83               DO C

                   SET @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"

               End DoDot:1

 +84       DO C

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

 +85       DO BL(GBL,.CNT,"SigText",SIGTXT)

 +86       DO C

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

 +87       IF $GET(REFREQ)

               DO BL(GBL,.CNT,"PharmacyRequestedRefills",REFREQ)

 +88       DO C

           SET @GBL@(CNT,0)="</MedicationDispensed>"

 +89       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

PSOERXOF.m