PSOERXOF ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581,635**;DEC 1997;Build 19
;
Q
; 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>"
Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOF 5179 printed Apr 09, 2024@21:31:44 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
