- PSOERXIE ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**581,617,746**;DEC 1997;Build 106
- ;
- Q
- MEDS(ERXIEN,MTYPE,MEDTYPE) ; medication prescribed/dispensed/requested segment
- N GL,I,SEQUENCE,DRUGDESC,DCPC,DCPQ,STRVAL,STRFORM,STRUOM,DEA,DCDBC,DCDBQ,CODELQ,QUOM,QVAL,DAYS,WDATE,LASTFD,SUBS,NUMREF,PHARMREF
- N PAUTH,NOTE,PASTAT,DNF,TZDQ,TZI,OCM,SUBREA,SPSCRIPT,RXI,OPAFFAIR,DELLOC,DELREQ,HASDEV,INSDEP,SUPPIND,RESTFREQ,FREQNOTE,INJREL,TREATIND,POE
- N CTC,NUMCYCLE,PRESREMS,REMSNUM,REMSCAT,FLAVREQ,NUMPDISP,PSP,PROVAUTH,NOLATER,NOLAREAS,PLOSAD,PROVAUTH,NMIEN,MIEN,SF,INMTYPE,F,TESTFREQ,RESPNOTE
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE))
- S I=-1,F=52.49,SF=52.49311,SEQUENCE=0
- S INMTYPE=$S(MEDTYPE="MedicationPrescribed":"P",MEDTYPE="MedicationDispensed":"D",MEDTYPE="MedicationRequested":"R",MEDTYPE="MedicationResponse":"MR",1:"")
- Q:INMTYPE=""
- F S I=$O(@GL@(I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S DRUGDESC=$G(@GL@(I,"DrugDescription",0))
- .S DCPC=$G(@GL@(I,"DrugCoded",0,"ProductCode",0,"Code",0))
- .S DCPQ=$G(@GL@(I,"DrugCoded",0,"ProductCode",0,"Qualifier",0))
- .S STRVAL=$G(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthValue",0))
- .S STRFORM=$G(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthForm",0,"Code",0))
- .S STRUOM=$G(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthUnitOfMeasure",0,"Code",0))
- .S DEA=$G(@GL@(I,"DrugCoded",0,"DEASchedule",0,"Code",0))
- .S DCDBC=$G(@GL@(I,"DrugCoded",0,"DrugDBCode",0,"Code",0))
- .S DCDBQ=$G(@GL@(I,"DrugCoded",0,"DrugDBCode",0,"Qualifier",0))
- .S CODELQ=$G(@GL@(I,"Quantity",0,"CodeListQualifier",0))
- .S QUOM=$G(@GL@(I,"Quantity",0,"QuantityUnitOfMeasure",0,"Code",0))
- .S QVAL=$G(@GL@(I,"Quantity",0,"Value",0))
- .S DAYS=$G(@GL@(I,"DaysSupply",0))
- .S WDATE=$G(@GL@(I,"WrittenDate",0,"Date",0))
- .I '$L(WDATE) S WDATE=$G(@GL@(I,"WrittenDate",0,"DateTime",0))
- .S WDATE=$$CONVDTTM^PSOERXA1(WDATE)
- .S LASTFD=$G(@GL@(I,"LastFillDate",0,"Date",0))
- .I '$L(LASTFD) S LASTFD=$G(@GL@(I,"LastFillDate",0,"DateTime",0))
- .S LASTFD=$$CONVDTTM^PSOERXA1(LASTFD)
- .S SUBS=$G(@GL@(I,"Substitutions",0))
- .S NUMREF=$G(@GL@(I,"NumberOfRefills",0))-$S(INMTYPE="R":1,1:0)
- .S PAUTH=$G(@GL@(I,"PriorAuthorization",0))
- .S NOTE=$G(@GL@(I,"Note",0))
- .S PASTAT=$G(@GL@(I,"PriorAuthorizationStatus",0))
- .; next 2 fields are for a renewal request/medication dispensed,
- .S PHARMREF=$G(@GL@(I,"PharmacyRequestedRefills",0))
- .S RESPNOTE=$G(@GL@(I,"Replace",0,"Note",0)) ; filing replace response note
- .S DNF=$G(@GL@(I,"DoNotFill",0))
- .S TZDQ=$G(@GL@(I,"TimeZone",0,"TimeZoneDifferenceQuantity",0))
- .S TZI=$G(@GL@(I,"TimeZone",0,"TimeZoneIdentifier",0))
- .S OCM=$G(@GL@(I,"OrderCaptureMethod",0))
- .S SUBREA=$G(@GL@(I,"ReasonForSubstitutionCodeUsed",0))
- .S SPSCRIPT=$G(@GL@(I,"SplitScript",0))
- .S RXI=$G(@GL@(I,"RxFillIndicator",0))
- .S OPAFFAIR=$G(@GL@(I,"OfficeOfPharmacyAffairsID",0)) ;***BUILD FUNCTION
- .S DELLOC=$G(@GL@(I,"DeliveryLocation",0))
- .S DELREQ=$G(@GL@(I,"DeliveryRequest",0))
- .S HASDEV=$G(@GL@(I,"DiabeticSupply",0,"HasAutomatedInsulinDevice",0))
- .S INSDEP=$G(@GL@(I,"DiabeticSupply",0,"InsulinDependent",0))
- .S SUPPIND=$G(@GL@(I,"DiabeticSupply",0,"SupplyIndicator",0))
- .S TESTFREQ=$G(@GL@(I,"DiabeticSupply",0,"TestingFrequency",0))
- .S FREQNOTE=$G(@GL@(I,"DiabeticSupply",0,"TestingFrequencyNotes",0))
- .S INJREL=$G(@GL@(I,"InjuryRelated",0))
- .S TREATIND=$G(@GL@(I,"TreatmentIndicator",0))
- .S POE=$G(@GL@(I,"ProphylacticOrEpisodic",0))
- .S CTC=$G(@GL@(I,"CurrentTreatmentCycle",0))
- .S NUMCYCLE=$G(@GL@(I,"NumberOfCyclesPlanned",0))
- .S PRESREMS=$G(@GL@(I,"PrescriberCheckedREMS",0))
- .S REMSNUM=$G(@GL@(I,"REMSAuthorizationNumber",0))
- .S REMSCAT=$G(@GL@(I,"REMSPatientRiskCategory",0))
- .;S PHARMTIT=$G(@GL@; dont see in XSD
- .S FLAVREQ=$G(@GL@(I,"FlavoringRequested",0))
- .S NUMPDISP=$G(@GL@(I,"NumberOfPackagesToBeDispensed",0))
- .S PSP=$G(@GL@(I,"PlaceOfServiceNonSelfAdministeredProduct",0))
- .S PROVAUTH=$G(@GL@(I,"ProviderExplicitAuthorizationToAdminister",0))
- .S NOLATER=$G(@GL@(I,"NeedNoLaterThan",0,"NeededNoLaterThanDate",0))
- .S NOLATER=$$CONVDTTM^PSOERXA1(NOLATER)
- .S NOLAREAS=$G(@GL@(I,"NeedNoLaterThan",0,"NeededNoLaterThanReason",0)) ; ***this appears to be a multiple in the XSD....talk to Brad about this one***
- .S PLOSAD=$G(@GL@(I,"PlaceOfServiceNonSelfAdministeredProduct",0))
- .S PROVAUTH=$G(@GL@(I,"ProviderExplicitAuthorizationToAdminister",0))
- .S IENS="+"_SEQUENCE_","_ERXIEN_","
- .; sequence, medication type, drug description
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=INMTYPE,FDA(SF,IENS,.03)=DRUGDESC
- .; dc product code, product code qualifier
- .S DCPQ=$$PRESOLV^PSOERXA1(DCPQ,"PQC")
- .S FDA(SF,IENS,1.1)=DCPC,FDA(SF,IENS,1.2)=DCPQ
- .; strength value, strength form, strength unit of measure
- .S STRFORM=$$PRESOLV^PSOERXA1(STRFORM,"NCI") ; resolving pointer
- .S STRUOM=$$PRESOLV^PSOERXA1(STRUOM,"NCI") ; resolving pointer
- .S FDA(SF,IENS,1.3)=STRVAL,FDA(SF,IENS,1.4)=STRFORM,FDA(SF,IENS,1.5)=STRUOM
- .; dc drug db code, dc drug db qual, dc dea
- .S DCDBQ=$$PRESOLV^PSOERXA1(DCDBQ,"DDB")
- .S DEA=$$PRESOLV^PSOERXA1(DEA,"NCI")
- .S FDA(SF,IENS,1.6)=DCDBC,FDA(SF,IENS,1.7)=DCDBQ,FDA(SF,IENS,1.8)=DEA
- .; quantity value quantity codelist qual, quantity unit of measure
- .S CODELQ=$$PRESOLV^PSOERXA1(CODELQ,"QCQ")
- .S QUOM=$$PRESOLV^PSOERXA1(QUOM,"NCI")
- .S FDA(SF,IENS,2.1)=QVAL,FDA(SF,IENS,2.2)=CODELQ,FDA(SF,IENS,2.3)=QUOM
- .; days supply, written date, last fill date
- .S FDA(SF,IENS,2.4)=DAYS,FDA(SF,IENS,2.5)=WDATE,FDA(SF,IENS,2.6)=LASTFD
- .; susbstitutions, number of refills
- .S FDA(SF,IENS,2.7)=SUBS,FDA(SF,IENS,2.8)=NUMREF
- .; prior authroization, prior authorization status, note, pharmacy requested refills, reason for substitution
- .S FDA(SF,IENS,4.1)=PAUTH,FDA(SF,IENS,4.2)=PASTAT,FDA(SF,IENS,5)=NOTE
- .S FDA(SF,IENS,4.3)=PHARMREF
- .; do not fill, time zone identifier, time zone diff qty
- .S FDA(SF,IENS,16.1)=DNF,FDA(SF,IENS,16.2)=TZI,FDA(SF,IENS,16.3)=TZDQ
- .; order capture method, reason for substitutions, split script, rx fill indicator
- .S FDA(SF,IENS,16.4)=OCM,FDA(SF,IENS,16.5)=SUBREA,FDA(SF,IENS,16.6)=SPSCRIPT,FDA(SF,IENS,16.7)=RXI
- .; delivery request, delivery location
- .S FDA(SF,IENS,18.1)=DELREQ,FDA(SF,IENS,18.2)=DELLOC
- .;diab supply test freq, diav supply indicator, diab insulin dependent, diab has auto device , diab supply freq notes
- .S FDA(SF,IENS,19.1)=TESTFREQ,FDA(SF,IENS,19.2)=SUPPIND,FDA(SF,IENS,19.3)=INSDEP,FDA(SF,IENS,19.4)=HASDEV,FDA(SF,IENS,19.5)=FREQNOTE
- .; injury related, treatment indicator, prophylactiv or episodic, current treatment ccle, number of cycles planned
- .S FDA(SF,IENS,20.1)=INJREL,FDA(SF,IENS,45.1)=TREATIND,FDA(SF,IENS,45.2)=POE,FDA(SF,IENS,45.3)=CTC,FDA(SF,IENS,45.4)=NUMCYCLE
- .; prescriber checked rems, rems patient risk, rems authorization
- .S FDA(SF,IENS,47)=PRESREMS,FDA(SF,IENS,48.1)=REMSCAT,FDA(SF,IENS,48.2)=REMSNUM
- .; flavoring requested, num packages dispensed, need no later than date, need no later than reason
- .S FDA(SF,IENS,55.1)=FLAVREQ,FDA(SF,IENS,58.1)=NUMPDISP,FDA(SF,IENS,63.1)=NOLATER,FDA(SF,IENS,63.2)=NOLAREAS
- .; place of service admin, provider authorization
- .S FDA(SF,IENS,63.3)=PLOSAD,FDA(SF,IENS,63.4)=PROVAUTH
- .D CFDA^PSOERXIU(.FDA)
- .D UPDATE^DIE(,"FDA","NMIEN") K FDA
- .; ALSO filing for old drug fields - only for Medication Prescribed
- .I INMTYPE="P"!(INMTYPE="MR") D
- ..S FDA(52.49,ERXIEN_",",5.1)=QVAL,FDA(52.49,ERXIEN_",",20.1)=QVAL,FDA(52.49,ERXIEN_",",42)=$$GET1^DIQ(52.45,QUOM,.02,"E")
- ..;S FDA(52.49,ERXIEN_",",5.2)=CODELQ
- ..S FDA(52.49,ERXIEN_",",5.4)=$$GET1^DIQ(52.45,QUOM,.02,"E")
- ..S FDA(52.49,ERXIEN_",",3.1)=DRUGDESC,FDA(52.49,ERXIEN_",",8)=NOTE
- ..S FDA(52.49,ERXIEN_",",43)=$$GET1^DIQ(52.45,STRUOM,.02,"E")
- ..I $G(DEA) S FDA(52.49,ERXIEN_",",4.9)=$$GET1^DIQ(52.45,DEA,.01)
- ..I $G(DNF)'="" S FDA(52.49,ERXIEN_",",10.5)=$S(DNF="Y":1,DNF="E":2,DNF="H":3,1:"")
- ..S FDA(52.49,ERXIEN_",",41)=$$GET1^DIQ(52.45,STRFORM,.02,"E")
- ..S FDA(52.49,ERXIEN_",",5.5)=DAYS,FDA(52.49,ERXIEN_",",20.2)=DAYS,FDA(52.49,ERXIEN_",",5.9)=WDATE,FDA(52.49,ERXIEN_",",6.1)=LASTFD
- ..S FDA(52.49,ERXIEN_",",5.8)=SUBS,FDA(52.49,ERXIEN_",",5.6)=NUMREF,FDA(52.49,ERXIEN_",",20.5)=NUMREF,FDA(52.49,ERXIEN_",",52.2)=RESPNOTE
- ..D CFDA^PSOERXIU(.FDA)
- ..D FILE^DIE(,"FDA") K FDA
- .; also file 52.1 with the refills requested value when this is a medication dispensed, and a renewal request
- .I INMTYPE="D",MTYPE="RxRenewalRequest" D
- ..S FDA(52.49,ERXIEN_",",51.2)=PHARMREF
- ..D CFDA^PSOERXIU(.FDA)
- ..D FILE^DIE(,"FDA") K FDA
- .S NMIEN=$O(NMIEN(0)),MIEN=$G(NMIEN(NMIEN))
- .D PHARMID(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parses and files pharmacy affairs data
- .D DIAG(ERXIEN,MIEN,MTYPE,MEDTYPE) ;parses and files diagnosis
- .D DRUGEVAL(ERXIEN,MIEN,MTYPE,MEDTYPE) ;parses and files drug use evaluation segment
- .D DRUGCS(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parses and files drug coverage status data
- .;parse and file the Sig segment
- .D SIG^PSOERXIF(ERXIEN,MIEN,MTYPE,MEDTYPE,I)
- .D AGENCY^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE) ;parse and file agency data (top level of 311)
- .D IVADMIN^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file IV administration data (top level of 311)
- .D WOUND^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file wound data
- .D TITRATE^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file titration data
- .D COMPOUND^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file compound ingredient information
- .D PATNOTES^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file patient codified notes
- .D FACTIME^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file facility specific hours of administration timing data
- .D OMEDDATE^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file other medication date data ; ***ask Brad about date/time, not sure if we need that field
- .K NMIEN,MIEN
- Q
- PHARMID(ERXIEN,MIEN,MTYPE,MEDTYPE) ;
- N PGL,I,SF,SEQUENCE,OPAFFAIR,IENS
- S PGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SEQUENCE=0,SF=52.4931117
- F S I=$O(@PGL@("OfficeOfPharmacyAffairsID",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S OPAFFAIR=$G(@PGL@("OfficeOfPharmacyAffairsID",I))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, affair ID
- .S FDA(SF,IENS,.01)=SEQUENCE
- .S FDA(SF,IENS,.02)=OPAFFAIR
- D UPDATE^DIE(,"FDA") K FDA
- Q
- DIAG(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file diagnosis data
- N DGL,I,SF,IENS,SEQUENCE,CLIQ,PDC,PDLV,PDD,PDQ,SDC,SDLV,SDD,SDQ,FDA
- S DGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SF=52.493113,SEQUENCE=0
- F S I=$O(@DGL@("Diagnosis",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S CLIQ=$G(@DGL@("Diagnosis",I,"ClinicalInformationQualifier",0))
- .S PDC=$G(@DGL@("Diagnosis",I,"Primary",0,"Code",0))
- .S PDLV=$G(@DGL@("Diagnosis",I,"Primary",0,"DateOfLastOfficeVisit",0,"Date",0))
- .I '$L(PDLV) S PDLV=$G(@DGL@("Diagnosis",I,"Primary",0,"DateOfLastOfficeVisit",0,"DateTime",0))
- .S PDLV=$$CONVDTTM^PSOERXA1(PDLV)
- .S PDD=$G(@DGL@("Diagnosis",I,"Primary",0,"Description",0))
- .S PDQ=$G(@DGL@("Diagnosis",I,"Primary",0,"Qualifier",0))
- .S SDC=$G(@DGL@("Diagnosis",I,"Secondary",0,"Code",0))
- .S SDLV=$G(@DGL@("Diagnosis",I,"Secondary",0,"DateOfLastOfficeVisit",0,"Date",0))
- .I '$L(SDLV) S SDLV=$G(@DGL@("Diagnosis",I,"Secondary",0,"DateOfLastOfficeVisit",0,"DateTime",0))
- .S SDLV=$$CONVDTTM^PSOERXA1(SDLV)
- .S SDD=$G(@DGL@("Diagnosis",I,"Secondary",0,"Description",0))
- .S SDQ=$G(@DGL@("Diagnosis",I,"Secondary",0,"Qualifier",0))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, clinical information qualifier
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=CLIQ
- .; primary diagnosis code, primary diagnosis qualifier, primary office visit date, primary diagnosis description
- .S FDA(SF,IENS,1.1)=PDC,FDA(SF,IENS,1.2)=PDQ,FDA(SF,IENS,1.3)=PDLV,FDA(SF,IENS,2)=PDD
- .; secondary diagnosis code, secondary diagnosis qualifier, secondary office visit date, secondary diagnosis description
- .S FDA(SF,IENS,3.1)=SDC,FDA(SF,IENS,3.2)=SDQ,FDA(SF,IENS,3.3)=SDLV,FDA(SF,IENS,4)=SDD
- D CFDA^PSOERXIU(.FDA)
- D UPDATE^DIE(,"FDA") K FDA
- Q
- DRUGEVAL(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file drug use evaluation data
- N DGL,I,SF,IENS,SEQUENCE,ACKR,CSCODE,COAC,COAD,COAQ,PSC,REACODE,RESCODE,FDA
- S DGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SF=52.493116,SEQUENCE=0
- F S I=$O(@DGL@("DrugUseEvaluation",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S ACKR=$G(@DGL@("DrugUseEvaluation",I,"AcknowledgementReason",0))
- .S CSCODE=$G(@DGL@("DrugUseEvaluation",I,"ClinicalSignificanceCode",0))
- .S COAC=$G(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Code",0))
- .S COAD=$G(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Description",0))
- .S COAQ=$G(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Qualifier",0))
- .S PSC=$G(@DGL@("DrugUseEvaluation",I,"ProfessionalServiceCode",0))
- .S REACODE=$G(@DGL@("DrugUseEvaluation",I,"ServiceReasonCode",0))
- .S RESCODE=$G(@DGL@("DrugUseEvaluation",I,"ServiceResultCode",0))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence
- .S FDA(SF,IENS,.01)=SEQUENCE
- .; drug use evaluation service reason code, professional service reason code, result code
- .S REACODE=$$PRESOLV^PSOERXA1(REACODE,"REA") ; resolving pointer
- .S PSC=$$PRESOLV^PSOERXA1(PSC,"PSC") ; resolving pointer
- .S RESCODE=$$PRESOLV^PSOERXA1(RESCODE,"RES") ; resolving pointer
- .S FDA(SF,IENS,.02)=REACODE,FDA(SF,IENS,.03)=PSC,FDA(SF,IENS,.04)=RESCODE
- .; drue use evaluation co agent code, co agent qualifier, clinical significance code
- .S COAQ=$$PRESOLV^PSOERXA1(COAQ,"CAQ") ; resolving pointer
- .S FDA(SF,IENS,.05)=COAC,FDA(SF,IENS,.06)=COAQ,FDA(SF,IENS,.07)=CSCODE
- .; drug use evaluation co agent description, acknowledgement reason
- .S FDA(SF,IENS,1)=COAD,FDA(SF,IENS,2)=ACKR
- .D CFDA^PSOERXIU(.FDA)
- .D UPDATE^DIE(,"FDA") K FDA
- Q
- DRUGCS(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parsing and filing drug coverage status data
- N CSGL,I,SF,IENS,SEQUENCE,DRUGCSC,FDA
- S CSGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SF=52.493117,SEQUENCE=0
- F S I=$O(@CSGL@("DrugCoverageStatusCode",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S DRUGCSC=$G(@CSGL@("DrugCoverageStatusCode",I))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, drug coverage status code
- .S FDA(SF,IENS,.01)=SEQUENCE
- .S DRUGCSC=$$PRESOLV^PSOERXA1(DRUGCSC,"DCS") ;resolving pointer
- .S FDA(SF,IENS,.02)=DRUGCSC
- .D CFDA^PSOERXIU(.FDA)
- .D UPDATE^DIE(,"FDA") K FDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXIE 14587 printed Jan 18, 2025@03:29:48 Page 2
- PSOERXIE ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**581,617,746**;DEC 1997;Build 106
- +2 ;
- +3 QUIT
- MEDS(ERXIEN,MTYPE,MEDTYPE) ; medication prescribed/dispensed/requested segment
- +1 NEW GL,I,SEQUENCE,DRUGDESC,DCPC,DCPQ,STRVAL,STRFORM,STRUOM,DEA,DCDBC,DCDBQ,CODELQ,QUOM,QVAL,DAYS,WDATE,LASTFD,SUBS,NUMREF,PHARMREF
- +2 NEW PAUTH,NOTE,PASTAT,DNF,TZDQ,TZI,OCM,SUBREA,SPSCRIPT,RXI,OPAFFAIR,DELLOC,DELREQ,HASDEV,INSDEP,SUPPIND,RESTFREQ,FREQNOTE,INJREL,TREATIND,POE
- +3 NEW CTC,NUMCYCLE,PRESREMS,REMSNUM,REMSCAT,FLAVREQ,NUMPDISP,PSP,PROVAUTH,NOLATER,NOLAREAS,PLOSAD,PROVAUTH,NMIEN,MIEN,SF,INMTYPE,F,TESTFREQ,RESPNOTE
- +4 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE))
- +5 SET I=-1
- SET F=52.49
- SET SF=52.49311
- SET SEQUENCE=0
- +6 SET INMTYPE=$SELECT(MEDTYPE="MedicationPrescribed":"P",MEDTYPE="MedicationDispensed":"D",MEDTYPE="MedicationRequested":"R",MEDTYPE="MedicationResponse":"MR",1:"")
- +7 if INMTYPE=""
- QUIT
- +8 FOR
- SET I=$ORDER(@GL@(I))
- if I=""
- QUIT
- Begin DoDot:1
- +9 SET SEQUENCE=SEQUENCE+1
- +10 SET DRUGDESC=$GET(@GL@(I,"DrugDescription",0))
- +11 SET DCPC=$GET(@GL@(I,"DrugCoded",0,"ProductCode",0,"Code",0))
- +12 SET DCPQ=$GET(@GL@(I,"DrugCoded",0,"ProductCode",0,"Qualifier",0))
- +13 SET STRVAL=$GET(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthValue",0))
- +14 SET STRFORM=$GET(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthForm",0,"Code",0))
- +15 SET STRUOM=$GET(@GL@(I,"DrugCoded",0,"Strength",0,"StrengthUnitOfMeasure",0,"Code",0))
- +16 SET DEA=$GET(@GL@(I,"DrugCoded",0,"DEASchedule",0,"Code",0))
- +17 SET DCDBC=$GET(@GL@(I,"DrugCoded",0,"DrugDBCode",0,"Code",0))
- +18 SET DCDBQ=$GET(@GL@(I,"DrugCoded",0,"DrugDBCode",0,"Qualifier",0))
- +19 SET CODELQ=$GET(@GL@(I,"Quantity",0,"CodeListQualifier",0))
- +20 SET QUOM=$GET(@GL@(I,"Quantity",0,"QuantityUnitOfMeasure",0,"Code",0))
- +21 SET QVAL=$GET(@GL@(I,"Quantity",0,"Value",0))
- +22 SET DAYS=$GET(@GL@(I,"DaysSupply",0))
- +23 SET WDATE=$GET(@GL@(I,"WrittenDate",0,"Date",0))
- +24 IF '$LENGTH(WDATE)
- SET WDATE=$GET(@GL@(I,"WrittenDate",0,"DateTime",0))
- +25 SET WDATE=$$CONVDTTM^PSOERXA1(WDATE)
- +26 SET LASTFD=$GET(@GL@(I,"LastFillDate",0,"Date",0))
- +27 IF '$LENGTH(LASTFD)
- SET LASTFD=$GET(@GL@(I,"LastFillDate",0,"DateTime",0))
- +28 SET LASTFD=$$CONVDTTM^PSOERXA1(LASTFD)
- +29 SET SUBS=$GET(@GL@(I,"Substitutions",0))
- +30 SET NUMREF=$GET(@GL@(I,"NumberOfRefills",0))-$SELECT(INMTYPE="R":1,1:0)
- +31 SET PAUTH=$GET(@GL@(I,"PriorAuthorization",0))
- +32 SET NOTE=$GET(@GL@(I,"Note",0))
- +33 SET PASTAT=$GET(@GL@(I,"PriorAuthorizationStatus",0))
- +34 ; next 2 fields are for a renewal request/medication dispensed,
- +35 SET PHARMREF=$GET(@GL@(I,"PharmacyRequestedRefills",0))
- +36 ; filing replace response note
- SET RESPNOTE=$GET(@GL@(I,"Replace",0,"Note",0))
- +37 SET DNF=$GET(@GL@(I,"DoNotFill",0))
- +38 SET TZDQ=$GET(@GL@(I,"TimeZone",0,"TimeZoneDifferenceQuantity",0))
- +39 SET TZI=$GET(@GL@(I,"TimeZone",0,"TimeZoneIdentifier",0))
- +40 SET OCM=$GET(@GL@(I,"OrderCaptureMethod",0))
- +41 SET SUBREA=$GET(@GL@(I,"ReasonForSubstitutionCodeUsed",0))
- +42 SET SPSCRIPT=$GET(@GL@(I,"SplitScript",0))
- +43 SET RXI=$GET(@GL@(I,"RxFillIndicator",0))
- +44 ;***BUILD FUNCTION
- SET OPAFFAIR=$GET(@GL@(I,"OfficeOfPharmacyAffairsID",0))
- +45 SET DELLOC=$GET(@GL@(I,"DeliveryLocation",0))
- +46 SET DELREQ=$GET(@GL@(I,"DeliveryRequest",0))
- +47 SET HASDEV=$GET(@GL@(I,"DiabeticSupply",0,"HasAutomatedInsulinDevice",0))
- +48 SET INSDEP=$GET(@GL@(I,"DiabeticSupply",0,"InsulinDependent",0))
- +49 SET SUPPIND=$GET(@GL@(I,"DiabeticSupply",0,"SupplyIndicator",0))
- +50 SET TESTFREQ=$GET(@GL@(I,"DiabeticSupply",0,"TestingFrequency",0))
- +51 SET FREQNOTE=$GET(@GL@(I,"DiabeticSupply",0,"TestingFrequencyNotes",0))
- +52 SET INJREL=$GET(@GL@(I,"InjuryRelated",0))
- +53 SET TREATIND=$GET(@GL@(I,"TreatmentIndicator",0))
- +54 SET POE=$GET(@GL@(I,"ProphylacticOrEpisodic",0))
- +55 SET CTC=$GET(@GL@(I,"CurrentTreatmentCycle",0))
- +56 SET NUMCYCLE=$GET(@GL@(I,"NumberOfCyclesPlanned",0))
- +57 SET PRESREMS=$GET(@GL@(I,"PrescriberCheckedREMS",0))
- +58 SET REMSNUM=$GET(@GL@(I,"REMSAuthorizationNumber",0))
- +59 SET REMSCAT=$GET(@GL@(I,"REMSPatientRiskCategory",0))
- +60 ;S PHARMTIT=$G(@GL@; dont see in XSD
- +61 SET FLAVREQ=$GET(@GL@(I,"FlavoringRequested",0))
- +62 SET NUMPDISP=$GET(@GL@(I,"NumberOfPackagesToBeDispensed",0))
- +63 SET PSP=$GET(@GL@(I,"PlaceOfServiceNonSelfAdministeredProduct",0))
- +64 SET PROVAUTH=$GET(@GL@(I,"ProviderExplicitAuthorizationToAdminister",0))
- +65 SET NOLATER=$GET(@GL@(I,"NeedNoLaterThan",0,"NeededNoLaterThanDate",0))
- +66 SET NOLATER=$$CONVDTTM^PSOERXA1(NOLATER)
- +67 ; ***this appears to be a multiple in the XSD....talk to Brad about this one***
- SET NOLAREAS=$GET(@GL@(I,"NeedNoLaterThan",0,"NeededNoLaterThanReason",0))
- +68 SET PLOSAD=$GET(@GL@(I,"PlaceOfServiceNonSelfAdministeredProduct",0))
- +69 SET PROVAUTH=$GET(@GL@(I,"ProviderExplicitAuthorizationToAdminister",0))
- +70 SET IENS="+"_SEQUENCE_","_ERXIEN_","
- +71 ; sequence, medication type, drug description
- +72 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=INMTYPE
- SET FDA(SF,IENS,.03)=DRUGDESC
- +73 ; dc product code, product code qualifier
- +74 SET DCPQ=$$PRESOLV^PSOERXA1(DCPQ,"PQC")
- +75 SET FDA(SF,IENS,1.1)=DCPC
- SET FDA(SF,IENS,1.2)=DCPQ
- +76 ; strength value, strength form, strength unit of measure
- +77 ; resolving pointer
- SET STRFORM=$$PRESOLV^PSOERXA1(STRFORM,"NCI")
- +78 ; resolving pointer
- SET STRUOM=$$PRESOLV^PSOERXA1(STRUOM,"NCI")
- +79 SET FDA(SF,IENS,1.3)=STRVAL
- SET FDA(SF,IENS,1.4)=STRFORM
- SET FDA(SF,IENS,1.5)=STRUOM
- +80 ; dc drug db code, dc drug db qual, dc dea
- +81 SET DCDBQ=$$PRESOLV^PSOERXA1(DCDBQ,"DDB")
- +82 SET DEA=$$PRESOLV^PSOERXA1(DEA,"NCI")
- +83 SET FDA(SF,IENS,1.6)=DCDBC
- SET FDA(SF,IENS,1.7)=DCDBQ
- SET FDA(SF,IENS,1.8)=DEA
- +84 ; quantity value quantity codelist qual, quantity unit of measure
- +85 SET CODELQ=$$PRESOLV^PSOERXA1(CODELQ,"QCQ")
- +86 SET QUOM=$$PRESOLV^PSOERXA1(QUOM,"NCI")
- +87 SET FDA(SF,IENS,2.1)=QVAL
- SET FDA(SF,IENS,2.2)=CODELQ
- SET FDA(SF,IENS,2.3)=QUOM
- +88 ; days supply, written date, last fill date
- +89 SET FDA(SF,IENS,2.4)=DAYS
- SET FDA(SF,IENS,2.5)=WDATE
- SET FDA(SF,IENS,2.6)=LASTFD
- +90 ; susbstitutions, number of refills
- +91 SET FDA(SF,IENS,2.7)=SUBS
- SET FDA(SF,IENS,2.8)=NUMREF
- +92 ; prior authroization, prior authorization status, note, pharmacy requested refills, reason for substitution
- +93 SET FDA(SF,IENS,4.1)=PAUTH
- SET FDA(SF,IENS,4.2)=PASTAT
- SET FDA(SF,IENS,5)=NOTE
- +94 SET FDA(SF,IENS,4.3)=PHARMREF
- +95 ; do not fill, time zone identifier, time zone diff qty
- +96 SET FDA(SF,IENS,16.1)=DNF
- SET FDA(SF,IENS,16.2)=TZI
- SET FDA(SF,IENS,16.3)=TZDQ
- +97 ; order capture method, reason for substitutions, split script, rx fill indicator
- +98 SET FDA(SF,IENS,16.4)=OCM
- SET FDA(SF,IENS,16.5)=SUBREA
- SET FDA(SF,IENS,16.6)=SPSCRIPT
- SET FDA(SF,IENS,16.7)=RXI
- +99 ; delivery request, delivery location
- +100 SET FDA(SF,IENS,18.1)=DELREQ
- SET FDA(SF,IENS,18.2)=DELLOC
- +101 ;diab supply test freq, diav supply indicator, diab insulin dependent, diab has auto device , diab supply freq notes
- +102 SET FDA(SF,IENS,19.1)=TESTFREQ
- SET FDA(SF,IENS,19.2)=SUPPIND
- SET FDA(SF,IENS,19.3)=INSDEP
- SET FDA(SF,IENS,19.4)=HASDEV
- SET FDA(SF,IENS,19.5)=FREQNOTE
- +103 ; injury related, treatment indicator, prophylactiv or episodic, current treatment ccle, number of cycles planned
- +104 SET FDA(SF,IENS,20.1)=INJREL
- SET FDA(SF,IENS,45.1)=TREATIND
- SET FDA(SF,IENS,45.2)=POE
- SET FDA(SF,IENS,45.3)=CTC
- SET FDA(SF,IENS,45.4)=NUMCYCLE
- +105 ; prescriber checked rems, rems patient risk, rems authorization
- +106 SET FDA(SF,IENS,47)=PRESREMS
- SET FDA(SF,IENS,48.1)=REMSCAT
- SET FDA(SF,IENS,48.2)=REMSNUM
- +107 ; flavoring requested, num packages dispensed, need no later than date, need no later than reason
- +108 SET FDA(SF,IENS,55.1)=FLAVREQ
- SET FDA(SF,IENS,58.1)=NUMPDISP
- SET FDA(SF,IENS,63.1)=NOLATER
- SET FDA(SF,IENS,63.2)=NOLAREAS
- +109 ; place of service admin, provider authorization
- +110 SET FDA(SF,IENS,63.3)=PLOSAD
- SET FDA(SF,IENS,63.4)=PROVAUTH
- +111 DO CFDA^PSOERXIU(.FDA)
- +112 DO UPDATE^DIE(,"FDA","NMIEN")
- KILL FDA
- +113 ; ALSO filing for old drug fields - only for Medication Prescribed
- +114 IF INMTYPE="P"!(INMTYPE="MR")
- Begin DoDot:2
- +115 SET FDA(52.49,ERXIEN_",",5.1)=QVAL
- SET FDA(52.49,ERXIEN_",",20.1)=QVAL
- SET FDA(52.49,ERXIEN_",",42)=$$GET1^DIQ(52.45,QUOM,.02,"E")
- +116 ;S FDA(52.49,ERXIEN_",",5.2)=CODELQ
- +117 SET FDA(52.49,ERXIEN_",",5.4)=$$GET1^DIQ(52.45,QUOM,.02,"E")
- +118 SET FDA(52.49,ERXIEN_",",3.1)=DRUGDESC
- SET FDA(52.49,ERXIEN_",",8)=NOTE
- +119 SET FDA(52.49,ERXIEN_",",43)=$$GET1^DIQ(52.45,STRUOM,.02,"E")
- +120 IF $GET(DEA)
- SET FDA(52.49,ERXIEN_",",4.9)=$$GET1^DIQ(52.45,DEA,.01)
- +121 IF $GET(DNF)'=""
- SET FDA(52.49,ERXIEN_",",10.5)=$SELECT(DNF="Y":1,DNF="E":2,DNF="H":3,1:"")
- +122 SET FDA(52.49,ERXIEN_",",41)=$$GET1^DIQ(52.45,STRFORM,.02,"E")
- +123 SET FDA(52.49,ERXIEN_",",5.5)=DAYS
- SET FDA(52.49,ERXIEN_",",20.2)=DAYS
- SET FDA(52.49,ERXIEN_",",5.9)=WDATE
- SET FDA(52.49,ERXIEN_",",6.1)=LASTFD
- +124 SET FDA(52.49,ERXIEN_",",5.8)=SUBS
- SET FDA(52.49,ERXIEN_",",5.6)=NUMREF
- SET FDA(52.49,ERXIEN_",",20.5)=NUMREF
- SET FDA(52.49,ERXIEN_",",52.2)=RESPNOTE
- +125 DO CFDA^PSOERXIU(.FDA)
- +126 DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:2
- +127 ; also file 52.1 with the refills requested value when this is a medication dispensed, and a renewal request
- +128 IF INMTYPE="D"
- IF MTYPE="RxRenewalRequest"
- Begin DoDot:2
- +129 SET FDA(52.49,ERXIEN_",",51.2)=PHARMREF
- +130 DO CFDA^PSOERXIU(.FDA)
- +131 DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:2
- +132 SET NMIEN=$ORDER(NMIEN(0))
- SET MIEN=$GET(NMIEN(NMIEN))
- +133 ; parses and files pharmacy affairs data
- DO PHARMID(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +134 ;parses and files diagnosis
- DO DIAG(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +135 ;parses and files drug use evaluation segment
- DO DRUGEVAL(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +136 ; parses and files drug coverage status data
- DO DRUGCS(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +137 ;parse and file the Sig segment
- +138 DO SIG^PSOERXIF(ERXIEN,MIEN,MTYPE,MEDTYPE,I)
- +139 ;parse and file agency data (top level of 311)
- DO AGENCY^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +140 ; parse and file IV administration data (top level of 311)
- DO IVADMIN^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +141 ; parse and file wound data
- DO WOUND^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +142 ; parse and file titration data
- DO TITRATE^PSOERXIG(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +143 ; parse and file compound ingredient information
- DO COMPOUND^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +144 ; parse and file patient codified notes
- DO PATNOTES^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +145 ; parse and file facility specific hours of administration timing data
- DO FACTIME^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +146 ; parse and file other medication date data ; ***ask Brad about date/time, not sure if we need that field
- DO OMEDDATE^PSOERXIH(ERXIEN,MIEN,MTYPE,MEDTYPE)
- +147 KILL NMIEN,MIEN
- End DoDot:1
- +148 QUIT
- PHARMID(ERXIEN,MIEN,MTYPE,MEDTYPE) ;
- +1 NEW PGL,I,SF,SEQUENCE,OPAFFAIR,IENS
- +2 SET PGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SEQUENCE=0
- SET SF=52.4931117
- +4 FOR
- SET I=$ORDER(@PGL@("OfficeOfPharmacyAffairsID",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET OPAFFAIR=$GET(@PGL@("OfficeOfPharmacyAffairsID",I))
- +7 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +8 ; sequence, affair ID
- +9 SET FDA(SF,IENS,.01)=SEQUENCE
- +10 SET FDA(SF,IENS,.02)=OPAFFAIR
- End DoDot:1
- +11 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +12 QUIT
- DIAG(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file diagnosis data
- +1 NEW DGL,I,SF,IENS,SEQUENCE,CLIQ,PDC,PDLV,PDD,PDQ,SDC,SDLV,SDD,SDQ,FDA
- +2 SET DGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SF=52.493113
- SET SEQUENCE=0
- +4 FOR
- SET I=$ORDER(@DGL@("Diagnosis",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET CLIQ=$GET(@DGL@("Diagnosis",I,"ClinicalInformationQualifier",0))
- +7 SET PDC=$GET(@DGL@("Diagnosis",I,"Primary",0,"Code",0))
- +8 SET PDLV=$GET(@DGL@("Diagnosis",I,"Primary",0,"DateOfLastOfficeVisit",0,"Date",0))
- +9 IF '$LENGTH(PDLV)
- SET PDLV=$GET(@DGL@("Diagnosis",I,"Primary",0,"DateOfLastOfficeVisit",0,"DateTime",0))
- +10 SET PDLV=$$CONVDTTM^PSOERXA1(PDLV)
- +11 SET PDD=$GET(@DGL@("Diagnosis",I,"Primary",0,"Description",0))
- +12 SET PDQ=$GET(@DGL@("Diagnosis",I,"Primary",0,"Qualifier",0))
- +13 SET SDC=$GET(@DGL@("Diagnosis",I,"Secondary",0,"Code",0))
- +14 SET SDLV=$GET(@DGL@("Diagnosis",I,"Secondary",0,"DateOfLastOfficeVisit",0,"Date",0))
- +15 IF '$LENGTH(SDLV)
- SET SDLV=$GET(@DGL@("Diagnosis",I,"Secondary",0,"DateOfLastOfficeVisit",0,"DateTime",0))
- +16 SET SDLV=$$CONVDTTM^PSOERXA1(SDLV)
- +17 SET SDD=$GET(@DGL@("Diagnosis",I,"Secondary",0,"Description",0))
- +18 SET SDQ=$GET(@DGL@("Diagnosis",I,"Secondary",0,"Qualifier",0))
- +19 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +20 ; sequence, clinical information qualifier
- +21 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=CLIQ
- +22 ; primary diagnosis code, primary diagnosis qualifier, primary office visit date, primary diagnosis description
- +23 SET FDA(SF,IENS,1.1)=PDC
- SET FDA(SF,IENS,1.2)=PDQ
- SET FDA(SF,IENS,1.3)=PDLV
- SET FDA(SF,IENS,2)=PDD
- +24 ; secondary diagnosis code, secondary diagnosis qualifier, secondary office visit date, secondary diagnosis description
- +25 SET FDA(SF,IENS,3.1)=SDC
- SET FDA(SF,IENS,3.2)=SDQ
- SET FDA(SF,IENS,3.3)=SDLV
- SET FDA(SF,IENS,4)=SDD
- End DoDot:1
- +26 DO CFDA^PSOERXIU(.FDA)
- +27 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +28 QUIT
- DRUGEVAL(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file drug use evaluation data
- +1 NEW DGL,I,SF,IENS,SEQUENCE,ACKR,CSCODE,COAC,COAD,COAQ,PSC,REACODE,RESCODE,FDA
- +2 SET DGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SF=52.493116
- SET SEQUENCE=0
- +4 FOR
- SET I=$ORDER(@DGL@("DrugUseEvaluation",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET ACKR=$GET(@DGL@("DrugUseEvaluation",I,"AcknowledgementReason",0))
- +7 SET CSCODE=$GET(@DGL@("DrugUseEvaluation",I,"ClinicalSignificanceCode",0))
- +8 SET COAC=$GET(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Code",0))
- +9 SET COAD=$GET(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Description",0))
- +10 SET COAQ=$GET(@DGL@("DrugUseEvaluation",I,"CoAgent",0,"CoAgentCode",0,"Qualifier",0))
- +11 SET PSC=$GET(@DGL@("DrugUseEvaluation",I,"ProfessionalServiceCode",0))
- +12 SET REACODE=$GET(@DGL@("DrugUseEvaluation",I,"ServiceReasonCode",0))
- +13 SET RESCODE=$GET(@DGL@("DrugUseEvaluation",I,"ServiceResultCode",0))
- +14 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +15 ; sequence
- +16 SET FDA(SF,IENS,.01)=SEQUENCE
- +17 ; drug use evaluation service reason code, professional service reason code, result code
- +18 ; resolving pointer
- SET REACODE=$$PRESOLV^PSOERXA1(REACODE,"REA")
- +19 ; resolving pointer
- SET PSC=$$PRESOLV^PSOERXA1(PSC,"PSC")
- +20 ; resolving pointer
- SET RESCODE=$$PRESOLV^PSOERXA1(RESCODE,"RES")
- +21 SET FDA(SF,IENS,.02)=REACODE
- SET FDA(SF,IENS,.03)=PSC
- SET FDA(SF,IENS,.04)=RESCODE
- +22 ; drue use evaluation co agent code, co agent qualifier, clinical significance code
- +23 ; resolving pointer
- SET COAQ=$$PRESOLV^PSOERXA1(COAQ,"CAQ")
- +24 SET FDA(SF,IENS,.05)=COAC
- SET FDA(SF,IENS,.06)=COAQ
- SET FDA(SF,IENS,.07)=CSCODE
- +25 ; drug use evaluation co agent description, acknowledgement reason
- +26 SET FDA(SF,IENS,1)=COAD
- SET FDA(SF,IENS,2)=ACKR
- +27 DO CFDA^PSOERXIU(.FDA)
- +28 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +29 QUIT
- DRUGCS(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parsing and filing drug coverage status data
- +1 NEW CSGL,I,SF,IENS,SEQUENCE,DRUGCSC,FDA
- +2 SET CSGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SF=52.493117
- SET SEQUENCE=0
- +4 FOR
- SET I=$ORDER(@CSGL@("DrugCoverageStatusCode",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET DRUGCSC=$GET(@CSGL@("DrugCoverageStatusCode",I))
- +7 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +8 ; sequence, drug coverage status code
- +9 SET FDA(SF,IENS,.01)=SEQUENCE
- +10 ;resolving pointer
- SET DRUGCSC=$$PRESOLV^PSOERXA1(DRUGCSC,"DCS")
- +11 SET FDA(SF,IENS,.02)=DRUGCSC
- +12 DO CFDA^PSOERXIU(.FDA)
- +13 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +14 QUIT