PSOERXX4 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,508**;DEC 1997;Build 295
;
Q
; GBL - global location
; IEN - erx ien
; REQOR - refill qualifier override (optional)
; REFREQ - refills requested
MEDPRES(GBL,IEN,REQOR,REFREQ) ;
N F,DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,QTYVAL,CLQUAL,USCODE,PUC,DAYSUPP
N DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,REVAL,PSDAT,DCS,DCSVAL,DCLOOP
N IENS,SIENS,SLOOP,RXIEN
S IENS=IEN_","
S F=52.49
D GETS^DIQ(F,IENS,"**","IE","PSDAT")
D CONVXML^PSOERXX1("PSDAT")
S DRUGDES=$G(PSDAT(F,IENS,3.1,"E"))
S PRODCODE=$G(PSDAT(F,IENS,4.1,"E"))
S PCQUAL=$G(PSDAT(F,IENS,4.2,"I"))
S STRENGTH=$G(PSDAT(F,IENS,4.3,"E"))
S DDBCODE=$G(PSDAT(F,IENS,4.4,"E"))
S DDBCQUAL=$G(PSDAT(F,IENS,4.11,"E"))
S FSCODE=$G(PSDAT(F,IENS,4.5,"I"))
S FCODE=$G(PSDAT(F,IENS,4.6,"E"))
S SSCODE=$G(PSDAT(F,IENS,4.7,"I"))
S SCODE=$G(PSDAT(F,IENS,4.8,"E"))
S DEASCH=$G(PSDAT(F,IENS,4.9,"E"))
S QTYVAL=$G(PSDAT(F,IENS,5.1,"E"))
S CLQUAL=$G(PSDAT(F,IENS,5.2,"I"))
S USCODE=$G(PSDAT(F,IENS,5.3,"I"))
S PUC=$G(PSDAT(F,IENS,5.4,"E"))
S DAYSUPP=$G(PSDAT(F,IENS,5.5,"E"))
S DIRECT=$G(PSDAT(F,IENS,7,"E"))
S NOTE=$G(PSDAT(F,IENS,8,"E"))
; PSO*508 - added logic to use the refills requeted and 'P' as the qualifier if this section is being built for a refill request.
; per guidelines, the refills requested should be sent in both the medication prescribed and med dispensed segments.
S REVAL=$S($G(REFREQ):REFREQ,1:$G(PSDAT(F,IENS,5.6,"E")))
I $G(REFREQ) S REQUAL="P"
I '$G(REFREQ) S REQUAL=$G(PSDAT(F,IENS,5.7,"I")) I REQUAL="R" S REQUAL="P"
S SUB=$G(PSDAT(F,IENS,5.8,"I"))
S WDATE=$G(PSDAT(F,IENS,5.9,"I")) I WDATE S WDATE=$P($$EXTIME^PSOERXO1(WDATE),"T")
S LFDATE=$G(PSDAT(F,IENS,6.1,"I")) I LFDATE S LFDATE=$P($$EXTIME^PSOERXO1(LFDATE),"T")
S EXDATE=$G(PSDAT(F,IENS,6.2,"I")) I EXDATE S EXDATE=$P($$EXTIME^PSOERXO1(EXDATE),"T")
S EFDATE=$G(PSDAT(F,IENS,6.3,"I")) I EFDATE S EFDATE=$P($$EXTIME^PSOERXO1(EFDATE),"T")
S PEND=$G(PSDAT(F,IENS,6.4,"I")) I PEND S PEND=$P($$EXTIME^PSOERXO1(PEND),"T")
S DOD=$G(PSDAT(F,IENS,6.5,"I")) I DOD S DOD=$P($$EXTIME^PSOERXO1(DOD),"T")
S DATEVAL=$G(PSDAT(F,IENS,6.6,"I")) I DATEVAL S DATEVAL=$P($$EXTIME^PSOERXO1(DATEVAL),"T")
S PAQUAL=$G(PSDAT(F,IENS,10.3,"E"))
S PAVAL=$G(PSDAT(F,IENS,10.2,"E"))
S PAS=$G(PSDAT(F,IENS,10.4,"I"))
D C S @GBL@(CNT,0)="<MedicationPrescribed>"
D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
I $L(PRODCODE)!($L(PCQUAL))!($L(STRENGTH))!($L(DDBCODE))!($L(DDBCQUAL))!($L(FSCODE))!($L(FCODE))!($L(SSCODE))!($L(SCODE))!($L(DEASCH)) D
.D C S @GBL@(CNT,0)="<DrugCoded>"
.I $L(PRODCODE) D C S @GBL@(CNT,0)="<ProductCode>"_PRODCODE_"</ProductCode>"
.I $L(PCQUAL) D C S @GBL@(CNT,0)="<ProductCodeQualifier>"_PCQUAL_"</ProductCodeQualifier>"
.I $L(STRENGTH) D C S @GBL@(CNT,0)="<Strength>"_STRENGTH_"</Strength>"
.I $L(DDBCODE) D C S @GBL@(CNT,0)="<DrugDBCode>"_DDBCODE_"</DrugDBCode>"
.I $L(DDBCQUAL) D C S @GBL@(CNT,0)="<DrugDBCodeQualifier>"_DDBCQUAL_"</DrugDBCodeQualifier>"
.I $L(FSCODE) D C S @GBL@(CNT,0)="<FormSourceCode>"_FSCODE_"</FormSourceCode>"
.I $L(FCODE) D C S @GBL@(CNT,0)="<FormCode>"_FCODE_"</FormCode>"
.I $L(SSCODE) D C S @GBL@(CNT,0)="<StrengthSourceCode>"_SSCODE_"</StrengthSourceCode>"
.I $L(SCODE) D C S @GBL@(CNT,0)="<StrengthCode>"_SCODE_"</StrengthCode>"
.I $L(DEASCH) D C S @GBL@(CNT,0)="<DEASchedule>"_DEASCH_"</DEASchedule>"
.D C S @GBL@(CNT,0)="</DrugCoded>"
I $L(QTYVAL)!($L(CLQUAL))!($L(USCODE))!($L(PUC)) D
.D C S @GBL@(CNT,0)="<Quantity>"
.I $L(QTYVAL) D C S @GBL@(CNT,0)="<Value>"_QTYVAL_"</Value>"
.I $L(CLQUAL) D C S @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
.I $L(USCODE) D C S @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
.I $L(PUC) D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
.D C S @GBL@(CNT,0)="</Quantity>"
I $L(DAYSUPP) D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
I $L(DIRECT) D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
I $L(NOTE) D C S @GBL@(CNT,0)="<Note>"_NOTE_"</Note>"
I $L(REQUAL)!($L(REVAL)) D
.D C S @GBL@(CNT,0)="<Refills>"
.I $L(REQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
.I $L(REVAL) D C S @GBL@(CNT,0)="<Value>"_REVAL_"</Value>"
.D C S @GBL@(CNT,0)="</Refills>"
I $L(SUB) D C S @GBL@(CNT,0)="<Substitutions>"_SUB_"</Substitutions>"
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(EXDATE) D
.D C S @GBL@(CNT,0)="<ExpirationDate>"
.D C S @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
.D C S @GBL@(CNT,0)="</ExpirationDate>"
I $L(EFDATE) D
.D C S @GBL@(CNT,0)="<EffectiveDate>"
.D C S @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
.D C S @GBL@(CNT,0)="</EffectiveDate>"
I $L(PEND) D
.D C S @GBL@(CNT,0)="<PeriodEnd>"
.D C S @GBL@(CNT,0)="<Date>"_PEND_"</Date>"
.D C S @GBL@(CNT,0)="</PeriodEnd>"
I $L(DOD) D
.D C S @GBL@(CNT,0)="<DeliveredOnDate>"
.D C S @GBL@(CNT,0)="<Date>"_DOD_"</Date>"
.D C S @GBL@(CNT,0)="</DeliveredOnDate>"
I $L(DATEVAL) D
.D C S @GBL@(CNT,0)="<DateValidated>"
.D C S @GBL@(CNT,0)="<Date>"_DATEVAL_"</Date>"
.D C S @GBL@(CNT,0)="</DateValidated>"
;***DO DIAGNOS, IT IS A MULTIPLE***
I $L(PAQUAL)!($L(PAVAL)) D
.D C S @GBL@(CNT,0)="<PriorAuthorization>"
.I $L(PAQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_PAQUAL_"</Qualifier>"
.I $L(PAVAL) D C S @GBL@(CNT,0)="<Value>"_PAVAL_"</Value>"
.D C S @GBL@(CNT,0)="</PriorAuthorization>"
;***DO DRUG USE EVAL***
S DCLOOP=0 F S DCLOOP=$O(^PS(52.49,IEN,28,DCLOOP)) Q:'DCLOOP D
.S DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_IENS,.02,"E")
.D C S @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
I $L(PAS) D C S @GBL@(CNT,0)="<PriorAuthorizationStatus>"_PAS_"</PriorAuthorizationStatus>"
S SLOOP=0 F S SLOOP=$O(^PS(52.49,IEN,11,SLOOP)) Q:'SLOOP D
.S SIENS=SLOOP_","_IEN_","
.D STRUCSIG^PSOERXX5(.GBL,SIENS)
D C S @GBL@(CNT,0)="</MedicationPrescribed>"
Q
; IEN - 52.49 IEN
; RXIEN - Prescription IEN (file #52)
; ORIEN - order IEN
; PSOIEN - eRx ien
; REFREQ - refills requested
MEDDIS(GBL,RXIEN,ORIEN,PSOIEN,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
;S F=52.49
; this is the section we will likely be using
S RXIENS=RXIEN_","
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"))
I DRUGIEN S DNDC=$TR($$GET1^DIQ(50,DRUGIEN,31,"E"),"-","")
I DNDC'="" D
.I $L($G(DNDC)<11) D
..S LESS=11-$L(DNDC)
..F I=1:1:LESS S DNDC=0_$G(DNDC)
S QTY=$G(RXDAT(52,RXIENS,7,"E"))
; FUTURE ENHANCEMENTS
; - the qualifier may change between rxfill and refill request
; - consider modifying quantity code list qualifier in 52.49 to be a set of codes.
; this is a refill request, so the codelistqualifier will always be 38 - original quantity
;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 CLQUAL=38
; 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"
; FUTURE ENHANCEMENT - find out how to identify potency unit code, for now use C38046 - Not Stated explicity or in detail
S PUC="C38046"
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 DIRECT=$E(SIGTXT,1,140),DIRECT=$$SYMENC^MXMLUTL(DIRECT)
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>"_DNDC_"</ProductCode>"
.D C S @GBL@(CNT,0)="<ProductCodeQualifier>ND</ProductCodeQualifier>"
.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)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
D C S @GBL@(CNT,0)="</Quantity>"
D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
I $L(REQUAL)!($L(RVAL)) D
.D C S @GBL@(CNT,0)="<Refills>"
.I $L(REQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
.I $L(RVAL) D C S @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
.D C S @GBL@(CNT,0)="</Refills>"
I $L(SUBST) D C S @GBL@(CNT,0)="<Substitutions>"_SUBST_"</Substitutions>"
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(EXDATE) D
.D C S @GBL@(CNT,0)="<ExpirationDate>"
.D C S @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
.D C S @GBL@(CNT,0)="</ExpirationDate>"
I $L(EFDATE) D
.D C S @GBL@(CNT,0)="<EffectiveDate>"
.D C S @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
.D C S @GBL@(CNT,0)="</EffectiveDate>"
S DCLOOP=0 F S DCLOOP=$O(^PS(52.49,PSOIEN,28,DCLOOP)) Q:'DCLOOP D
.S DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_PSOIEN_",",.02,"E")
.D C S @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
D C S @GBL@(CNT,0)="</MedicationDispensed>"
Q
MEDREQ(GBL,IEN,DDAT) ;
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
S F=52.49
; FUTURE ENHANCEMENT - FOR NOW BUILD HEADER AND FOOTER AND QUIT. tHIS MAY NEED TO LOOK AT 52.41 OR 52 FOR DATA
S DRUGDES=$G(DDAT("DRUG"))
S QTY=$G(DDAT("QTY"))
S DAYSUPP=$G(DDAT("DSUP"))
S RVAL=$G(DDAT("REF"))
S DIRECT=$G(DDAT("DIR"))
S REQUAL="R"
S CLQUAL="TEST"
S USCODE="TEST"
S PUC="TEST"
D C S @GBL@(CNT,0)="<MedicationRequested>"
D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
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)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
D C S @GBL@(CNT,0)="</Quantity>"
D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
D C S @GBL@(CNT,0)="<Refills>"
D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
D C S @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
D C S @GBL@(CNT,0)="</Refills>"
D C S @GBL@(CNT,0)="</MedicationRequested>"
Q
C ;
S CNT=$G(CNT)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXX4 12869 printed Sep 23, 2025@20:05:40 Page 2
PSOERXX4 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**467,508**;DEC 1997;Build 295
+2 ;
+3 QUIT
+4 ; GBL - global location
+5 ; IEN - erx ien
+6 ; REQOR - refill qualifier override (optional)
+7 ; REFREQ - refills requested
MEDPRES(GBL,IEN,REQOR,REFREQ) ;
+1 NEW F,DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,QTYVAL,CLQUAL,USCODE,PUC,DAYSUPP
+2 NEW DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,REVAL,PSDAT,DCS,DCSVAL,DCLOOP
+3 NEW IENS,SIENS,SLOOP,RXIEN
+4 SET IENS=IEN_","
+5 SET F=52.49
+6 DO GETS^DIQ(F,IENS,"**","IE","PSDAT")
+7 DO CONVXML^PSOERXX1("PSDAT")
+8 SET DRUGDES=$GET(PSDAT(F,IENS,3.1,"E"))
+9 SET PRODCODE=$GET(PSDAT(F,IENS,4.1,"E"))
+10 SET PCQUAL=$GET(PSDAT(F,IENS,4.2,"I"))
+11 SET STRENGTH=$GET(PSDAT(F,IENS,4.3,"E"))
+12 SET DDBCODE=$GET(PSDAT(F,IENS,4.4,"E"))
+13 SET DDBCQUAL=$GET(PSDAT(F,IENS,4.11,"E"))
+14 SET FSCODE=$GET(PSDAT(F,IENS,4.5,"I"))
+15 SET FCODE=$GET(PSDAT(F,IENS,4.6,"E"))
+16 SET SSCODE=$GET(PSDAT(F,IENS,4.7,"I"))
+17 SET SCODE=$GET(PSDAT(F,IENS,4.8,"E"))
+18 SET DEASCH=$GET(PSDAT(F,IENS,4.9,"E"))
+19 SET QTYVAL=$GET(PSDAT(F,IENS,5.1,"E"))
+20 SET CLQUAL=$GET(PSDAT(F,IENS,5.2,"I"))
+21 SET USCODE=$GET(PSDAT(F,IENS,5.3,"I"))
+22 SET PUC=$GET(PSDAT(F,IENS,5.4,"E"))
+23 SET DAYSUPP=$GET(PSDAT(F,IENS,5.5,"E"))
+24 SET DIRECT=$GET(PSDAT(F,IENS,7,"E"))
+25 SET NOTE=$GET(PSDAT(F,IENS,8,"E"))
+26 ; PSO*508 - added logic to use the refills requeted and 'P' as the qualifier if this section is being built for a refill request.
+27 ; per guidelines, the refills requested should be sent in both the medication prescribed and med dispensed segments.
+28 SET REVAL=$SELECT($GET(REFREQ):REFREQ,1:$GET(PSDAT(F,IENS,5.6,"E")))
+29 IF $GET(REFREQ)
SET REQUAL="P"
+30 IF '$GET(REFREQ)
SET REQUAL=$GET(PSDAT(F,IENS,5.7,"I"))
IF REQUAL="R"
SET REQUAL="P"
+31 SET SUB=$GET(PSDAT(F,IENS,5.8,"I"))
+32 SET WDATE=$GET(PSDAT(F,IENS,5.9,"I"))
IF WDATE
SET WDATE=$PIECE($$EXTIME^PSOERXO1(WDATE),"T")
+33 SET LFDATE=$GET(PSDAT(F,IENS,6.1,"I"))
IF LFDATE
SET LFDATE=$PIECE($$EXTIME^PSOERXO1(LFDATE),"T")
+34 SET EXDATE=$GET(PSDAT(F,IENS,6.2,"I"))
IF EXDATE
SET EXDATE=$PIECE($$EXTIME^PSOERXO1(EXDATE),"T")
+35 SET EFDATE=$GET(PSDAT(F,IENS,6.3,"I"))
IF EFDATE
SET EFDATE=$PIECE($$EXTIME^PSOERXO1(EFDATE),"T")
+36 SET PEND=$GET(PSDAT(F,IENS,6.4,"I"))
IF PEND
SET PEND=$PIECE($$EXTIME^PSOERXO1(PEND),"T")
+37 SET DOD=$GET(PSDAT(F,IENS,6.5,"I"))
IF DOD
SET DOD=$PIECE($$EXTIME^PSOERXO1(DOD),"T")
+38 SET DATEVAL=$GET(PSDAT(F,IENS,6.6,"I"))
IF DATEVAL
SET DATEVAL=$PIECE($$EXTIME^PSOERXO1(DATEVAL),"T")
+39 SET PAQUAL=$GET(PSDAT(F,IENS,10.3,"E"))
+40 SET PAVAL=$GET(PSDAT(F,IENS,10.2,"E"))
+41 SET PAS=$GET(PSDAT(F,IENS,10.4,"I"))
+42 DO C
SET @GBL@(CNT,0)="<MedicationPrescribed>"
+43 DO C
SET @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
+44 IF $LENGTH(PRODCODE)!($LENGTH(PCQUAL))!($LENGTH(STRENGTH))!($LENGTH(DDBCODE))!($LENGTH(DDBCQUAL))!($LENGTH(FSCODE))!($LENGTH(FCODE))!($LENGTH(SSCODE))!($LENGTH(SCODE))!($LENGTH(DEASCH))
Begin DoDot:1
+45 DO C
SET @GBL@(CNT,0)="<DrugCoded>"
+46 IF $LENGTH(PRODCODE)
DO C
SET @GBL@(CNT,0)="<ProductCode>"_PRODCODE_"</ProductCode>"
+47 IF $LENGTH(PCQUAL)
DO C
SET @GBL@(CNT,0)="<ProductCodeQualifier>"_PCQUAL_"</ProductCodeQualifier>"
+48 IF $LENGTH(STRENGTH)
DO C
SET @GBL@(CNT,0)="<Strength>"_STRENGTH_"</Strength>"
+49 IF $LENGTH(DDBCODE)
DO C
SET @GBL@(CNT,0)="<DrugDBCode>"_DDBCODE_"</DrugDBCode>"
+50 IF $LENGTH(DDBCQUAL)
DO C
SET @GBL@(CNT,0)="<DrugDBCodeQualifier>"_DDBCQUAL_"</DrugDBCodeQualifier>"
+51 IF $LENGTH(FSCODE)
DO C
SET @GBL@(CNT,0)="<FormSourceCode>"_FSCODE_"</FormSourceCode>"
+52 IF $LENGTH(FCODE)
DO C
SET @GBL@(CNT,0)="<FormCode>"_FCODE_"</FormCode>"
+53 IF $LENGTH(SSCODE)
DO C
SET @GBL@(CNT,0)="<StrengthSourceCode>"_SSCODE_"</StrengthSourceCode>"
+54 IF $LENGTH(SCODE)
DO C
SET @GBL@(CNT,0)="<StrengthCode>"_SCODE_"</StrengthCode>"
+55 IF $LENGTH(DEASCH)
DO C
SET @GBL@(CNT,0)="<DEASchedule>"_DEASCH_"</DEASchedule>"
+56 DO C
SET @GBL@(CNT,0)="</DrugCoded>"
End DoDot:1
+57 IF $LENGTH(QTYVAL)!($LENGTH(CLQUAL))!($LENGTH(USCODE))!($LENGTH(PUC))
Begin DoDot:1
+58 DO C
SET @GBL@(CNT,0)="<Quantity>"
+59 IF $LENGTH(QTYVAL)
DO C
SET @GBL@(CNT,0)="<Value>"_QTYVAL_"</Value>"
+60 IF $LENGTH(CLQUAL)
DO C
SET @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
+61 IF $LENGTH(USCODE)
DO C
SET @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
+62 IF $LENGTH(PUC)
DO C
SET @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
+63 DO C
SET @GBL@(CNT,0)="</Quantity>"
End DoDot:1
+64 IF $LENGTH(DAYSUPP)
DO C
SET @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
+65 IF $LENGTH(DIRECT)
DO C
SET @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
+66 IF $LENGTH(NOTE)
DO C
SET @GBL@(CNT,0)="<Note>"_NOTE_"</Note>"
+67 IF $LENGTH(REQUAL)!($LENGTH(REVAL))
Begin DoDot:1
+68 DO C
SET @GBL@(CNT,0)="<Refills>"
+69 IF $LENGTH(REQUAL)
DO C
SET @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
+70 IF $LENGTH(REVAL)
DO C
SET @GBL@(CNT,0)="<Value>"_REVAL_"</Value>"
+71 DO C
SET @GBL@(CNT,0)="</Refills>"
End DoDot:1
+72 IF $LENGTH(SUB)
DO C
SET @GBL@(CNT,0)="<Substitutions>"_SUB_"</Substitutions>"
+73 IF $LENGTH(WDATE)
Begin DoDot:1
+74 DO C
SET @GBL@(CNT,0)="<WrittenDate>"
+75 DO C
SET @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"
+76 DO C
SET @GBL@(CNT,0)="</WrittenDate>"
End DoDot:1
+77 IF $LENGTH(LFDATE)
Begin DoDot:1
+78 DO C
SET @GBL@(CNT,0)="<LastFillDate>"
+79 DO C
SET @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"
+80 DO C
SET @GBL@(CNT,0)="</LastFillDate>"
End DoDot:1
+81 IF $LENGTH(EXDATE)
Begin DoDot:1
+82 DO C
SET @GBL@(CNT,0)="<ExpirationDate>"
+83 DO C
SET @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
+84 DO C
SET @GBL@(CNT,0)="</ExpirationDate>"
End DoDot:1
+85 IF $LENGTH(EFDATE)
Begin DoDot:1
+86 DO C
SET @GBL@(CNT,0)="<EffectiveDate>"
+87 DO C
SET @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
+88 DO C
SET @GBL@(CNT,0)="</EffectiveDate>"
End DoDot:1
+89 IF $LENGTH(PEND)
Begin DoDot:1
+90 DO C
SET @GBL@(CNT,0)="<PeriodEnd>"
+91 DO C
SET @GBL@(CNT,0)="<Date>"_PEND_"</Date>"
+92 DO C
SET @GBL@(CNT,0)="</PeriodEnd>"
End DoDot:1
+93 IF $LENGTH(DOD)
Begin DoDot:1
+94 DO C
SET @GBL@(CNT,0)="<DeliveredOnDate>"
+95 DO C
SET @GBL@(CNT,0)="<Date>"_DOD_"</Date>"
+96 DO C
SET @GBL@(CNT,0)="</DeliveredOnDate>"
End DoDot:1
+97 IF $LENGTH(DATEVAL)
Begin DoDot:1
+98 DO C
SET @GBL@(CNT,0)="<DateValidated>"
+99 DO C
SET @GBL@(CNT,0)="<Date>"_DATEVAL_"</Date>"
+100 DO C
SET @GBL@(CNT,0)="</DateValidated>"
End DoDot:1
+101 ;***DO DIAGNOS, IT IS A MULTIPLE***
+102 IF $LENGTH(PAQUAL)!($LENGTH(PAVAL))
Begin DoDot:1
+103 DO C
SET @GBL@(CNT,0)="<PriorAuthorization>"
+104 IF $LENGTH(PAQUAL)
DO C
SET @GBL@(CNT,0)="<Qualifier>"_PAQUAL_"</Qualifier>"
+105 IF $LENGTH(PAVAL)
DO C
SET @GBL@(CNT,0)="<Value>"_PAVAL_"</Value>"
+106 DO C
SET @GBL@(CNT,0)="</PriorAuthorization>"
End DoDot:1
+107 ;***DO DRUG USE EVAL***
+108 SET DCLOOP=0
FOR
SET DCLOOP=$ORDER(^PS(52.49,IEN,28,DCLOOP))
if 'DCLOOP
QUIT
Begin DoDot:1
+109 SET DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_IENS,.02,"E")
+110 DO C
SET @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
End DoDot:1
+111 IF $LENGTH(PAS)
DO C
SET @GBL@(CNT,0)="<PriorAuthorizationStatus>"_PAS_"</PriorAuthorizationStatus>"
+112 SET SLOOP=0
FOR
SET SLOOP=$ORDER(^PS(52.49,IEN,11,SLOOP))
if 'SLOOP
QUIT
Begin DoDot:1
+113 SET SIENS=SLOOP_","_IEN_","
+114 DO STRUCSIG^PSOERXX5(.GBL,SIENS)
End DoDot:1
+115 DO C
SET @GBL@(CNT,0)="</MedicationPrescribed>"
+116 QUIT
+117 ; IEN - 52.49 IEN
+118 ; RXIEN - Prescription IEN (file #52)
+119 ; ORIEN - order IEN
+120 ; PSOIEN - eRx ien
+121 ; REFREQ - refills requested
MEDDIS(GBL,RXIEN,ORIEN,PSOIEN,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
+4 ;S F=52.49
+5 ; this is the section we will likely be using
+6 SET RXIENS=RXIEN_","
+7 DO GETS^DIQ(52,RXIENS,"1;6;7;8;9;10;10.2;101","IE","RXDAT")
+8 DO CONVXML^PSOERXX1("RXDAT")
+9 SET DRUGDES=$GET(RXDAT(52,RXIENS,6,"E"))
+10 SET DRUGIEN=$GET(RXDAT(52,RXIENS,6,"I"))
+11 IF DRUGIEN
SET DNDC=$TRANSLATE($$GET1^DIQ(50,DRUGIEN,31,"E"),"-","")
+12 IF DNDC'=""
Begin DoDot:1
+13 IF $LENGTH($GET(DNDC)<11)
Begin DoDot:2
+14 SET LESS=11-$LENGTH(DNDC)
+15 FOR I=1:1:LESS
SET DNDC=0_$GET(DNDC)
End DoDot:2
End DoDot:1
+16 SET QTY=$GET(RXDAT(52,RXIENS,7,"E"))
+17 ; FUTURE ENHANCEMENTS
+18 ; - the qualifier may change between rxfill and refill request
+19 ; - consider modifying quantity code list qualifier in 52.49 to be a set of codes.
+20 ; this is a refill request, so the codelistqualifier will always be 38 - original quantity
+21 ;38 Original Quantity
+22 ;40 Remaining Quantity
+23 ;87 Quantity Received
+24 ;QS Quantity sufficient as determined by the dispensing pharmacy.
+25 ; Quantity to be based on established dispensing protocols between
+26 ; the prescriber and pharmacy/pharmacist.
+27 ; FUTURE - WHEN THIS IS USED, CLQUAL MAY NEED TO BE CALCULATED AND NOT HARD CODED
+28 SET CLQUAL=38
+29 ; how to determine Unit Source Code?
+30 ;AA - NCI values of Diagnostic, Therapeutic, and Research Equipment - Pharmaceutical Dosage Form (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
+31 ;AB - NCI values of Units of Presentation (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
+32 ;AC - NCI values of Property or Attribute - Unit of Measure - Unit of Category - Potency Unit (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
+33 ; FOR NOW SET IT TO AA
+34 SET USCODE="AA"
+35 ; FUTURE ENHANCEMENT - find out how to identify potency unit code, for now use C38046 - Not Stated explicity or in detail
+36 SET PUC="C38046"
+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 DIRECT=$EXTRACT(SIGTXT,1,140)
SET DIRECT=$$SYMENC^MXMLUTL(DIRECT)
+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>"_DNDC_"</ProductCode>"
+59 DO C
SET @GBL@(CNT,0)="<ProductCodeQualifier>ND</ProductCodeQualifier>"
+60 DO C
SET @GBL@(CNT,0)="</DrugCoded>"
End DoDot:1
+61 DO C
SET @GBL@(CNT,0)="<Quantity>"
+62 DO C
SET @GBL@(CNT,0)="<Value>"_QTY_"</Value>"
+63 DO C
SET @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
+64 DO C
SET @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
+65 DO C
SET @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
+66 DO C
SET @GBL@(CNT,0)="</Quantity>"
+67 DO C
SET @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
+68 DO C
SET @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
+69 IF $LENGTH(REQUAL)!($LENGTH(RVAL))
Begin DoDot:1
+70 DO C
SET @GBL@(CNT,0)="<Refills>"
+71 IF $LENGTH(REQUAL)
DO C
SET @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
+72 IF $LENGTH(RVAL)
DO C
SET @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
+73 DO C
SET @GBL@(CNT,0)="</Refills>"
End DoDot:1
+74 IF $LENGTH(SUBST)
DO C
SET @GBL@(CNT,0)="<Substitutions>"_SUBST_"</Substitutions>"
+75 IF $LENGTH(WDATE)
Begin DoDot:1
+76 DO C
SET @GBL@(CNT,0)="<WrittenDate>"
+77 DO C
SET @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"
+78 DO C
SET @GBL@(CNT,0)="</WrittenDate>"
End DoDot:1
+79 IF $LENGTH(LFDATE)
Begin DoDot:1
+80 DO C
SET @GBL@(CNT,0)="<LastFillDate>"
+81 DO C
SET @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"
+82 DO C
SET @GBL@(CNT,0)="</LastFillDate>"
End DoDot:1
+83 IF $LENGTH(EXDATE)
Begin DoDot:1
+84 DO C
SET @GBL@(CNT,0)="<ExpirationDate>"
+85 DO C
SET @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
+86 DO C
SET @GBL@(CNT,0)="</ExpirationDate>"
End DoDot:1
+87 IF $LENGTH(EFDATE)
Begin DoDot:1
+88 DO C
SET @GBL@(CNT,0)="<EffectiveDate>"
+89 DO C
SET @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
+90 DO C
SET @GBL@(CNT,0)="</EffectiveDate>"
End DoDot:1
+91 SET DCLOOP=0
FOR
SET DCLOOP=$ORDER(^PS(52.49,PSOIEN,28,DCLOOP))
if 'DCLOOP
QUIT
Begin DoDot:1
+92 SET DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_PSOIEN_",",.02,"E")
+93 DO C
SET @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
End DoDot:1
+94 DO C
SET @GBL@(CNT,0)="</MedicationDispensed>"
+95 QUIT
MEDREQ(GBL,IEN,DDAT) ;
+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
+3 SET F=52.49
+4 ; FUTURE ENHANCEMENT - FOR NOW BUILD HEADER AND FOOTER AND QUIT. tHIS MAY NEED TO LOOK AT 52.41 OR 52 FOR DATA
+5 SET DRUGDES=$GET(DDAT("DRUG"))
+6 SET QTY=$GET(DDAT("QTY"))
+7 SET DAYSUPP=$GET(DDAT("DSUP"))
+8 SET RVAL=$GET(DDAT("REF"))
+9 SET DIRECT=$GET(DDAT("DIR"))
+10 SET REQUAL="R"
+11 SET CLQUAL="TEST"
+12 SET USCODE="TEST"
+13 SET PUC="TEST"
+14 DO C
SET @GBL@(CNT,0)="<MedicationRequested>"
+15 DO C
SET @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
+16 DO C
SET @GBL@(CNT,0)="<Quantity>"
+17 DO C
SET @GBL@(CNT,0)="<Value>"_QTY_"</Value>"
+18 DO C
SET @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
+19 DO C
SET @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
+20 DO C
SET @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
+21 DO C
SET @GBL@(CNT,0)="</Quantity>"
+22 DO C
SET @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
+23 DO C
SET @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
+24 DO C
SET @GBL@(CNT,0)="<Refills>"
+25 DO C
SET @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
+26 DO C
SET @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
+27 DO C
SET @GBL@(CNT,0)="</Refills>"
+28 DO C
SET @GBL@(CNT,0)="</MedicationRequested>"
+29 QUIT
C ;
+1 SET CNT=$GET(CNT)+1
+2 QUIT
