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 Nov 22, 2024@17:38:39 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
