Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERXX4

PSOERXX4.m

Go to the documentation of this file.
  1. PSOERXX4 ;ALB/BWF - eRx xml utilities ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**467,508**;DEC 1997;Build 295
  1. ;
  1. Q
  1. ; GBL - global location
  1. ; IEN - erx ien
  1. ; REQOR - refill qualifier override (optional)
  1. ; REFREQ - refills requested
  1. MEDPRES(GBL,IEN,REQOR,REFREQ) ;
  1. N F,DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,QTYVAL,CLQUAL,USCODE,PUC,DAYSUPP
  1. N DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,REVAL,PSDAT,DCS,DCSVAL,DCLOOP
  1. N IENS,SIENS,SLOOP,RXIEN
  1. S IENS=IEN_","
  1. S F=52.49
  1. D GETS^DIQ(F,IENS,"**","IE","PSDAT")
  1. D CONVXML^PSOERXX1("PSDAT")
  1. S DRUGDES=$G(PSDAT(F,IENS,3.1,"E"))
  1. S PRODCODE=$G(PSDAT(F,IENS,4.1,"E"))
  1. S PCQUAL=$G(PSDAT(F,IENS,4.2,"I"))
  1. S STRENGTH=$G(PSDAT(F,IENS,4.3,"E"))
  1. S DDBCODE=$G(PSDAT(F,IENS,4.4,"E"))
  1. S DDBCQUAL=$G(PSDAT(F,IENS,4.11,"E"))
  1. S FSCODE=$G(PSDAT(F,IENS,4.5,"I"))
  1. S FCODE=$G(PSDAT(F,IENS,4.6,"E"))
  1. S SSCODE=$G(PSDAT(F,IENS,4.7,"I"))
  1. S SCODE=$G(PSDAT(F,IENS,4.8,"E"))
  1. S DEASCH=$G(PSDAT(F,IENS,4.9,"E"))
  1. S QTYVAL=$G(PSDAT(F,IENS,5.1,"E"))
  1. S CLQUAL=$G(PSDAT(F,IENS,5.2,"I"))
  1. S USCODE=$G(PSDAT(F,IENS,5.3,"I"))
  1. S PUC=$G(PSDAT(F,IENS,5.4,"E"))
  1. S DAYSUPP=$G(PSDAT(F,IENS,5.5,"E"))
  1. S DIRECT=$G(PSDAT(F,IENS,7,"E"))
  1. S NOTE=$G(PSDAT(F,IENS,8,"E"))
  1. ; PSO*508 - added logic to use the refills requeted and 'P' as the qualifier if this section is being built for a refill request.
  1. ; per guidelines, the refills requested should be sent in both the medication prescribed and med dispensed segments.
  1. S REVAL=$S($G(REFREQ):REFREQ,1:$G(PSDAT(F,IENS,5.6,"E")))
  1. I $G(REFREQ) S REQUAL="P"
  1. I '$G(REFREQ) S REQUAL=$G(PSDAT(F,IENS,5.7,"I")) I REQUAL="R" S REQUAL="P"
  1. S SUB=$G(PSDAT(F,IENS,5.8,"I"))
  1. S WDATE=$G(PSDAT(F,IENS,5.9,"I")) I WDATE S WDATE=$P($$EXTIME^PSOERXO1(WDATE),"T")
  1. S LFDATE=$G(PSDAT(F,IENS,6.1,"I")) I LFDATE S LFDATE=$P($$EXTIME^PSOERXO1(LFDATE),"T")
  1. S EXDATE=$G(PSDAT(F,IENS,6.2,"I")) I EXDATE S EXDATE=$P($$EXTIME^PSOERXO1(EXDATE),"T")
  1. S EFDATE=$G(PSDAT(F,IENS,6.3,"I")) I EFDATE S EFDATE=$P($$EXTIME^PSOERXO1(EFDATE),"T")
  1. S PEND=$G(PSDAT(F,IENS,6.4,"I")) I PEND S PEND=$P($$EXTIME^PSOERXO1(PEND),"T")
  1. S DOD=$G(PSDAT(F,IENS,6.5,"I")) I DOD S DOD=$P($$EXTIME^PSOERXO1(DOD),"T")
  1. S DATEVAL=$G(PSDAT(F,IENS,6.6,"I")) I DATEVAL S DATEVAL=$P($$EXTIME^PSOERXO1(DATEVAL),"T")
  1. S PAQUAL=$G(PSDAT(F,IENS,10.3,"E"))
  1. S PAVAL=$G(PSDAT(F,IENS,10.2,"E"))
  1. S PAS=$G(PSDAT(F,IENS,10.4,"I"))
  1. D C S @GBL@(CNT,0)="<MedicationPrescribed>"
  1. D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
  1. I $L(PRODCODE)!($L(PCQUAL))!($L(STRENGTH))!($L(DDBCODE))!($L(DDBCQUAL))!($L(FSCODE))!($L(FCODE))!($L(SSCODE))!($L(SCODE))!($L(DEASCH)) D
  1. .D C S @GBL@(CNT,0)="<DrugCoded>"
  1. .I $L(PRODCODE) D C S @GBL@(CNT,0)="<ProductCode>"_PRODCODE_"</ProductCode>"
  1. .I $L(PCQUAL) D C S @GBL@(CNT,0)="<ProductCodeQualifier>"_PCQUAL_"</ProductCodeQualifier>"
  1. .I $L(STRENGTH) D C S @GBL@(CNT,0)="<Strength>"_STRENGTH_"</Strength>"
  1. .I $L(DDBCODE) D C S @GBL@(CNT,0)="<DrugDBCode>"_DDBCODE_"</DrugDBCode>"
  1. .I $L(DDBCQUAL) D C S @GBL@(CNT,0)="<DrugDBCodeQualifier>"_DDBCQUAL_"</DrugDBCodeQualifier>"
  1. .I $L(FSCODE) D C S @GBL@(CNT,0)="<FormSourceCode>"_FSCODE_"</FormSourceCode>"
  1. .I $L(FCODE) D C S @GBL@(CNT,0)="<FormCode>"_FCODE_"</FormCode>"
  1. .I $L(SSCODE) D C S @GBL@(CNT,0)="<StrengthSourceCode>"_SSCODE_"</StrengthSourceCode>"
  1. .I $L(SCODE) D C S @GBL@(CNT,0)="<StrengthCode>"_SCODE_"</StrengthCode>"
  1. .I $L(DEASCH) D C S @GBL@(CNT,0)="<DEASchedule>"_DEASCH_"</DEASchedule>"
  1. .D C S @GBL@(CNT,0)="</DrugCoded>"
  1. I $L(QTYVAL)!($L(CLQUAL))!($L(USCODE))!($L(PUC)) D
  1. .D C S @GBL@(CNT,0)="<Quantity>"
  1. .I $L(QTYVAL) D C S @GBL@(CNT,0)="<Value>"_QTYVAL_"</Value>"
  1. .I $L(CLQUAL) D C S @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
  1. .I $L(USCODE) D C S @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
  1. .I $L(PUC) D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
  1. .D C S @GBL@(CNT,0)="</Quantity>"
  1. I $L(DAYSUPP) D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
  1. I $L(DIRECT) D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
  1. I $L(NOTE) D C S @GBL@(CNT,0)="<Note>"_NOTE_"</Note>"
  1. I $L(REQUAL)!($L(REVAL)) D
  1. .D C S @GBL@(CNT,0)="<Refills>"
  1. .I $L(REQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
  1. .I $L(REVAL) D C S @GBL@(CNT,0)="<Value>"_REVAL_"</Value>"
  1. .D C S @GBL@(CNT,0)="</Refills>"
  1. I $L(SUB) D C S @GBL@(CNT,0)="<Substitutions>"_SUB_"</Substitutions>"
  1. I $L(WDATE) D
  1. .D C S @GBL@(CNT,0)="<WrittenDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</WrittenDate>"
  1. I $L(LFDATE) D
  1. .D C S @GBL@(CNT,0)="<LastFillDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</LastFillDate>"
  1. I $L(EXDATE) D
  1. .D C S @GBL@(CNT,0)="<ExpirationDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</ExpirationDate>"
  1. I $L(EFDATE) D
  1. .D C S @GBL@(CNT,0)="<EffectiveDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</EffectiveDate>"
  1. I $L(PEND) D
  1. .D C S @GBL@(CNT,0)="<PeriodEnd>"
  1. .D C S @GBL@(CNT,0)="<Date>"_PEND_"</Date>"
  1. .D C S @GBL@(CNT,0)="</PeriodEnd>"
  1. I $L(DOD) D
  1. .D C S @GBL@(CNT,0)="<DeliveredOnDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_DOD_"</Date>"
  1. .D C S @GBL@(CNT,0)="</DeliveredOnDate>"
  1. I $L(DATEVAL) D
  1. .D C S @GBL@(CNT,0)="<DateValidated>"
  1. .D C S @GBL@(CNT,0)="<Date>"_DATEVAL_"</Date>"
  1. .D C S @GBL@(CNT,0)="</DateValidated>"
  1. ;***DO DIAGNOS, IT IS A MULTIPLE***
  1. I $L(PAQUAL)!($L(PAVAL)) D
  1. .D C S @GBL@(CNT,0)="<PriorAuthorization>"
  1. .I $L(PAQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_PAQUAL_"</Qualifier>"
  1. .I $L(PAVAL) D C S @GBL@(CNT,0)="<Value>"_PAVAL_"</Value>"
  1. .D C S @GBL@(CNT,0)="</PriorAuthorization>"
  1. ;***DO DRUG USE EVAL***
  1. S DCLOOP=0 F S DCLOOP=$O(^PS(52.49,IEN,28,DCLOOP)) Q:'DCLOOP D
  1. .S DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_IENS,.02,"E")
  1. .D C S @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
  1. I $L(PAS) D C S @GBL@(CNT,0)="<PriorAuthorizationStatus>"_PAS_"</PriorAuthorizationStatus>"
  1. S SLOOP=0 F S SLOOP=$O(^PS(52.49,IEN,11,SLOOP)) Q:'SLOOP D
  1. .S SIENS=SLOOP_","_IEN_","
  1. .D STRUCSIG^PSOERXX5(.GBL,SIENS)
  1. D C S @GBL@(CNT,0)="</MedicationPrescribed>"
  1. Q
  1. ; IEN - 52.49 IEN
  1. ; RXIEN - Prescription IEN (file #52)
  1. ; ORIEN - order IEN
  1. ; PSOIEN - eRx ien
  1. ; REFREQ - refills requested
  1. MEDDIS(GBL,RXIEN,ORIEN,PSOIEN,REFREQ) ;
  1. N DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,VALUE,CLQUAL,USCODE,PUC,DAYSUPP
  1. N F,DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS,SIGTXT,SIGLOOP
  1. N RXDAT,RXIENS,DRUGDES,QTY,RXDAT,RVAL,DRUGIEN,DNDC,SUBST,LESS,I,DCLOOP,DCSVAL
  1. ;S F=52.49
  1. ; this is the section we will likely be using
  1. S RXIENS=RXIEN_","
  1. D GETS^DIQ(52,RXIENS,"1;6;7;8;9;10;10.2;101","IE","RXDAT")
  1. D CONVXML^PSOERXX1("RXDAT")
  1. S DRUGDES=$G(RXDAT(52,RXIENS,6,"E"))
  1. S DRUGIEN=$G(RXDAT(52,RXIENS,6,"I"))
  1. I DRUGIEN S DNDC=$TR($$GET1^DIQ(50,DRUGIEN,31,"E"),"-","")
  1. I DNDC'="" D
  1. .I $L($G(DNDC)<11) D
  1. ..S LESS=11-$L(DNDC)
  1. ..F I=1:1:LESS S DNDC=0_$G(DNDC)
  1. S QTY=$G(RXDAT(52,RXIENS,7,"E"))
  1. ; FUTURE ENHANCEMENTS
  1. ; - the qualifier may change between rxfill and refill request
  1. ; - consider modifying quantity code list qualifier in 52.49 to be a set of codes.
  1. ; this is a refill request, so the codelistqualifier will always be 38 - original quantity
  1. ;38 Original Quantity
  1. ;40 Remaining Quantity
  1. ;87 Quantity Received
  1. ;QS Quantity sufficient as determined by the dispensing pharmacy.
  1. ; Quantity to be based on established dispensing protocols between
  1. ; the prescriber and pharmacy/pharmacist.
  1. ; FUTURE - WHEN THIS IS USED, CLQUAL MAY NEED TO BE CALCULATED AND NOT HARD CODED
  1. S CLQUAL=38
  1. ; how to determine Unit Source Code?
  1. ;AA - NCI values of Diagnostic, Therapeutic, and Research Equipment - Pharmaceutical Dosage Form (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
  1. ;AB - NCI values of Units of Presentation (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
  1. ;AC - NCI values of Property or Attribute - Unit of Measure - Unit of Category - Potency Unit (http://www.cancer.gov/cancertopics/terminologyresources/page4- NCI Thesaurus)
  1. ; FOR NOW SET IT TO AA
  1. S USCODE="AA"
  1. ; FUTURE ENHANCEMENT - find out how to identify potency unit code, for now use C38046 - Not Stated explicity or in detail
  1. S PUC="C38046"
  1. S DAYSUPP=$G(RXDAT(52,RXIENS,8,"E"))
  1. ; DIRECTIONS COME FROM SIG, FIELD 10
  1. ; FUTURE ENHANCEMENT - SHOULD WE GRAB ALL INFORMATION FROM THE SIG1 MULTIPLE? 52,10.2
  1. S SIGLOOP=0 F S SIGLOOP=$O(^PSRX(RXIEN,"SIG1",SIGLOOP)) Q:'SIGLOOP D
  1. .I '$D(SIGTXT) S SIGTXT=$G(^PSRX(RXIEN,"SIG1",SIGLOOP,0)) Q
  1. .S SIGTXT=SIGTXT_" "_$G(^PSRX(RXIEN,"SIG1",SIGLOOP,0))
  1. S DIRECT=$E(SIGTXT,1,140),DIRECT=$$SYMENC^MXMLUTL(DIRECT)
  1. S REQUAL=$$GET1^DIQ(52.49,PSOIEN,5.7,"I")
  1. I REQUAL="R" S REQUAL="P"
  1. S SUBST=$$GET1^DIQ(52.49,PSOIEN,5.8,"I")
  1. S RVAL=$S($D(REFREQ):REFREQ,1:$G(RXDAT(52,RXIENS,9,"E")))
  1. I $D(REFREQ) S REQUAL="P"
  1. ; CONVERT DATE types, ALSO MAKE SURE WE NEED TO POPULATE THESE.. MAY NOT BE NEEDED
  1. S LFDATE=$G(RXDAT(52,RXIENS,101,"I")) I LFDATE S LFDATE=$P($$EXTIME^PSOERXO1(LFDATE),"T")
  1. S EXDATE=$G(RXDAT(52,RXIENS,26,"I")) I EXDATE S EXDATE=$P($$EXTIME^PSOERXO1(EXDATE),"T")
  1. S WDATE=$G(RXDAT(52,RXIENS,1,"I")) I WDATE S WDATE=$P($$EXTIME^PSOERXO1(WDATE),"T")
  1. S EFDATE=""
  1. D C S @GBL@(CNT,0)="<MedicationDispensed>"
  1. D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
  1. I $L($G(DNDC)) D
  1. .D C S @GBL@(CNT,0)="<DrugCoded>"
  1. .D C S @GBL@(CNT,0)="<ProductCode>"_DNDC_"</ProductCode>"
  1. .D C S @GBL@(CNT,0)="<ProductCodeQualifier>ND</ProductCodeQualifier>"
  1. .D C S @GBL@(CNT,0)="</DrugCoded>"
  1. D C S @GBL@(CNT,0)="<Quantity>"
  1. D C S @GBL@(CNT,0)="<Value>"_QTY_"</Value>"
  1. D C S @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
  1. D C S @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
  1. D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
  1. D C S @GBL@(CNT,0)="</Quantity>"
  1. D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
  1. D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
  1. I $L(REQUAL)!($L(RVAL)) D
  1. .D C S @GBL@(CNT,0)="<Refills>"
  1. .I $L(REQUAL) D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
  1. .I $L(RVAL) D C S @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
  1. .D C S @GBL@(CNT,0)="</Refills>"
  1. I $L(SUBST) D C S @GBL@(CNT,0)="<Substitutions>"_SUBST_"</Substitutions>"
  1. I $L(WDATE) D
  1. .D C S @GBL@(CNT,0)="<WrittenDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_WDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</WrittenDate>"
  1. I $L(LFDATE) D
  1. .D C S @GBL@(CNT,0)="<LastFillDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_LFDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</LastFillDate>"
  1. I $L(EXDATE) D
  1. .D C S @GBL@(CNT,0)="<ExpirationDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_EXDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</ExpirationDate>"
  1. I $L(EFDATE) D
  1. .D C S @GBL@(CNT,0)="<EffectiveDate>"
  1. .D C S @GBL@(CNT,0)="<Date>"_EFDATE_"</Date>"
  1. .D C S @GBL@(CNT,0)="</EffectiveDate>"
  1. S DCLOOP=0 F S DCLOOP=$O(^PS(52.49,PSOIEN,28,DCLOOP)) Q:'DCLOOP D
  1. .S DCSVAL=$$GET1^DIQ(52.4928,DCLOOP_","_PSOIEN_",",.02,"E")
  1. .D C S @GBL@(CNT,0)="<DrugCoverageStatusCode>"_DCSVAL_"</DrugCoverageStatusCode>"
  1. D C S @GBL@(CNT,0)="</MedicationDispensed>"
  1. Q
  1. MEDREQ(GBL,IEN,DDAT) ;
  1. N DRUGDES,PRODCODE,PCQUAL,STRENGTH,DDBCODE,DDBCQUAL,FSCODE,FCODE,SSCODE,SCODE,DEASCH,VALUE,CLQUAL,USCODE,PUC,DAYSUPP
  1. N F,DIRECT,NOTE,REQUAL,SUB,WDATE,LFDATE,EXDATE,EFDATE,PEND,DOD,DATEVAL,PAQUAL,PAVAL,DCS,PAS
  1. S F=52.49
  1. ; FUTURE ENHANCEMENT - FOR NOW BUILD HEADER AND FOOTER AND QUIT. tHIS MAY NEED TO LOOK AT 52.41 OR 52 FOR DATA
  1. S DRUGDES=$G(DDAT("DRUG"))
  1. S QTY=$G(DDAT("QTY"))
  1. S DAYSUPP=$G(DDAT("DSUP"))
  1. S RVAL=$G(DDAT("REF"))
  1. S DIRECT=$G(DDAT("DIR"))
  1. S REQUAL="R"
  1. S CLQUAL="TEST"
  1. S USCODE="TEST"
  1. S PUC="TEST"
  1. D C S @GBL@(CNT,0)="<MedicationRequested>"
  1. D C S @GBL@(CNT,0)="<DrugDescription>"_DRUGDES_"</DrugDescription>"
  1. D C S @GBL@(CNT,0)="<Quantity>"
  1. D C S @GBL@(CNT,0)="<Value>"_QTY_"</Value>"
  1. D C S @GBL@(CNT,0)="<CodeListQualifier>"_CLQUAL_"</CodeListQualifier>"
  1. D C S @GBL@(CNT,0)="<UnitSourceCode>"_USCODE_"</UnitSourceCode>"
  1. D C S @GBL@(CNT,0)="<PotencyUnitCode>"_PUC_"</PotencyUnitCode>"
  1. D C S @GBL@(CNT,0)="</Quantity>"
  1. D C S @GBL@(CNT,0)="<DaysSupply>"_DAYSUPP_"</DaysSupply>"
  1. D C S @GBL@(CNT,0)="<Directions>"_DIRECT_"</Directions>"
  1. D C S @GBL@(CNT,0)="<Refills>"
  1. D C S @GBL@(CNT,0)="<Qualifier>"_REQUAL_"</Qualifier>"
  1. D C S @GBL@(CNT,0)="<Value>"_RVAL_"</Value>"
  1. D C S @GBL@(CNT,0)="</Refills>"
  1. D C S @GBL@(CNT,0)="</MedicationRequested>"
  1. Q
  1. C ;
  1. S CNT=$G(CNT)+1
  1. Q