- PSOERXIH ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
- ;
- Q
- OMEDDATE(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file other medication date data ; ***ask Brad about date/time, not sure if we need that field
- N OGL,I,SEQUENCE,SF,DATE,QUAL,IENS,FDA,SF,EFFDT,FDA,EXDT
- S OGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SEQUENCE=0,SF=52.4931162
- F S I=$O(@OGL@("OtherMedicationDate",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S DATE=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"Date",0))
- .I '$L(DATE) S DATE=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"DateTime",0))
- .S DATE=$$CONVDTTM^PSOERXA1(DATE)
- .S QUAL=$G(@OGL@("OtherMedicationDate",I,"OtherMedicationDateQualifier",0))
- .I QUAL="EffectiveDate" S EFFDT=DATE
- .I QUAL="ExpirationDate" S EXDT=DATE
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, other medicaiton date, other medication date qualifier
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=DATE,FDA(SF,IENS,.03)=QUAL
- D CFDA^PSOERXIU(.FDA)
- D UPDATE^DIE(,"FDA") K FDA
- ; file the effective and expiration dates in the old fields as well.
- I $D(EFFDT) S FDA(52.49,ERXIEN_",",6.3)=EFFDT
- I $D(EXDT) S FDA(52.49,ERXIEN_",",6.2)=EXDT
- I $D(FDA) D FILE^DIE(,"FDA") K FDA
- Q
- FACTIME(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file facility specific hours of administration timing data
- N FGL,I,SEQUENCE,SF,ADCODE,ADQUAL,ADTEXT,ADVAL,IENS,FDA,SF
- S FGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SEQUENCE=0,SF=52.4931161
- F S I=$O(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S ADCODE=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Code",0))
- .S ADQUAL=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Qualifier",0))
- .S ADTEXT=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Text",0))
- .S ADVAL=$G(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministrationValue",0))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, hours of administration code, hours of adminstraiton qualifier, hours of adminstration text, hours of adminstration value
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=ADVAL,FDA(SF,IENS,1)=ADTEXT,FDA(SF,IENS,2.1)=ADQUAL,FDA(SF,IENS,2.2)=ADCODE
- D CFDA^PSOERXIU(.FDA)
- D UPDATE^DIE(,"FDA") K FDA
- Q
- PATNOTES(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file patient codified notes
- N PGL,I,SEQUENCE,SF,QUAL,VALUE,IENS,FDA,SF
- S PGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- S I=-1,SEQUENCE=0,SF=52.4931159
- F S I=$O(@PGL@("PatientCodifiedNote",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S QUAL=$G(@PGL@("PatientCodifiedNote",I,"Qualifier",0))
- .S VALUE=$G(@PGL@("PatientCodifiedNote",I,"Value",0))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, qualifier, value
- .S QUAL=$$PRESOLV^PSOERXA1(QUAL,"PCQ") ; resolving pointer
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=QUAL,FDA(SF,IENS,.03)=VALUE
- D UPDATE^DIE(,"FDA") K FDA
- Q
- COMPOUND(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file compound ingredient information
- ; create field in 52.49311 after the compound ingredients multiple. field will live outside of the loop (1 instance) - final compound pharamceutical dosage form
- N CGL,I,SF,SEQUENCE,COMPID,DEA,INCODE,INQUAL,STRFORM,STRUOMCD,STRVAL,ACKREA,CLINSC,COAGCODE,COAGQUAL,PROFSC,REACODE,RESCODE,CLQUAL,QUOMCODE,QUANTITY,IENS,FDA
- N SF,COAGDESC,FNLCMPDF
- S CGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0,"CompoundInformation",0))
- S I=-1,SEQUENCE=0,SF=52.4931157
- F S I=$O(@CGL@("CompoundIngredientsLotNotUsed",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S COMPID=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"CompoundIngredientItemDescription",0))
- .S DEA=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"DEASchedule",0,"Code",0))
- .S INCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Code",0))
- .S INQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Qualifier",0))
- .S STRFORM=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthForm",0,"Code",0))
- .S STRUOMCD=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthUnitOfMeasure",0,"Code",0))
- .S STRVAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthValue",0))
- .S ACKREA=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"AcknowledgementReason",0))
- .S CLINSC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ClinicalSignificanceCode",0))
- .S COAGCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Code",0))
- .S COAGDESC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Description",0))
- .S COAGQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Qualifier",0))
- .S PROFSC=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ProfessionalServiceCode",0))
- .S REACODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceReasonCode",0))
- .S RESCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceResultCode",0))
- .S CLQUAL=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"CodeListQualifier",0))
- .S QUOMCODE=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"QuantityUnitOfMeasure",0,"Code",0))
- .S QUANTITY=$G(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"Value",0))
- .S IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- .; sequence, comp ingredient, comp ingredient item desc, item number code, item number qualifier
- .S INQUAL=$$PRESOLV^PSOERXA1(INQUAL,"ICQ") ; resolving pointer
- .S FDA(SF,IENS,.01)=SEQUENCE,FDA(SF,IENS,.02)=COMPID,FDA(SF,IENS,.03)=INCODE,FDA(SF,IENS,.04)=INQUAL
- .; strength value, strength form, strength unit of measure, dea schedule code
- .S STRFORM=$$PRESOLV^PSOERXA1(STRFORM,"NCI") ; resolving pointer
- .S STRUOMCD=$$PRESOLV^PSOERXA1(STRUOMCD,"NCI") ; resolving pointer
- .S DEA=$$PRESOLV^PSOERXA1(DEA,"NCI") ; resolving pointer
- .S FDA(SF,IENS,1.1)=STRVAL,FDA(SF,IENS,1.2)=STRFORM,FDA(SF,IENS,1.3)=STRUOMCD,FDA(SF,IENS,1.4)=DEA
- .; compound quantity , compound qual, compound quantity unit of measure
- .S CLQUAL=$$PRESOLV^PSOERXA1(CLQUAL,"QCQ") ; resolving pointer
- .S QUOMCODE=$$PRESOLV^PSOERXA1(QUOMCODE,"NCI") ; resolving pointer
- .S FDA(SF,IENS,2.1)=QUANTITY,FDA(SF,IENS,2.2)=CLQUAL,FDA(SF,IENS,2.3)=QUOMCODE
- .; service reason code, professional service code, service result code
- .S REACODE=$$PRESOLV^PSOERXA1(REACODE,"REA") ; resolving pointer
- .S PROFSC=$$PRESOLV^PSOERXA1(PROFSC,"PSC") ; resolving pointer
- .S RESCODE=$$PRESOLV^PSOERXA1(RESCODE,"RES") ; resolving pointer
- .S FDA(SF,IENS,3.1)=REACODE,FDA(SF,IENS,3.2)=PROFSC,FDA(SF,IENS,3.3)=RESCODE
- .; co-agent code, co-agent qualifier, clinical significance code, acknowledgement reason, co-agent description
- .S COAGQUAL=$$PRESOLV^PSOERXA1(COAGQUAL,"CAQ") ; resolving pointer
- .S FDA(SF,IENS,3.4)=COAGCODE,FDA(SF,IENS,3.5)=COAGQUAL,FDA(SF,IENS,3.6)=CLINSC,FDA(SF,IENS,3.7)=ACKREA,FDA(SF,IENS,4)=COAGDESC
- D CFDA^PSOERXIU(.FDA)
- D UPDATE^DIE(,"FDA") K FDA
- S FNLCMPDF=$G(@CGL@("FinalCompoundPharmaceuticalDosageForm",0))
- S FNLCMPDF=$$PRESOLV^PSOERXA1(FNLCMPDF,"NCI")
- S FDA(52.49311,MIEN_","_ERXIEN_",",81)=FNLCMPDF D FILE^DIE(,"FDA") K FDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXIH 7666 printed Jan 18, 2025@03:29:51 Page 2
- PSOERXIH ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
- +2 ;
- +3 QUIT
- OMEDDATE(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file other medication date data ; ***ask Brad about date/time, not sure if we need that field
- +1 NEW OGL,I,SEQUENCE,SF,DATE,QUAL,IENS,FDA,SF,EFFDT,FDA,EXDT
- +2 SET OGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SEQUENCE=0
- SET SF=52.4931162
- +4 FOR
- SET I=$ORDER(@OGL@("OtherMedicationDate",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET DATE=$GET(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"Date",0))
- +7 IF '$LENGTH(DATE)
- SET DATE=$GET(@OGL@("OtherMedicationDate",I,"OtherMedicationDate",0,"DateTime",0))
- +8 SET DATE=$$CONVDTTM^PSOERXA1(DATE)
- +9 SET QUAL=$GET(@OGL@("OtherMedicationDate",I,"OtherMedicationDateQualifier",0))
- +10 IF QUAL="EffectiveDate"
- SET EFFDT=DATE
- +11 IF QUAL="ExpirationDate"
- SET EXDT=DATE
- +12 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +13 ; sequence, other medicaiton date, other medication date qualifier
- +14 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=DATE
- SET FDA(SF,IENS,.03)=QUAL
- End DoDot:1
- +15 DO CFDA^PSOERXIU(.FDA)
- +16 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +17 ; file the effective and expiration dates in the old fields as well.
- +18 IF $DATA(EFFDT)
- SET FDA(52.49,ERXIEN_",",6.3)=EFFDT
- +19 IF $DATA(EXDT)
- SET FDA(52.49,ERXIEN_",",6.2)=EXDT
- +20 IF $DATA(FDA)
- DO FILE^DIE(,"FDA")
- KILL FDA
- +21 QUIT
- FACTIME(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file facility specific hours of administration timing data
- +1 NEW FGL,I,SEQUENCE,SF,ADCODE,ADQUAL,ADTEXT,ADVAL,IENS,FDA,SF
- +2 SET FGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0))
- +3 SET I=-1
- SET SEQUENCE=0
- SET SF=52.4931161
- +4 FOR
- SET I=$ORDER(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET ADCODE=$GET(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Code",0))
- +7 SET ADQUAL=$GET(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Qualifier",0))
- +8 SET ADTEXT=$GET(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministration",0,"Text",0))
- +9 SET ADVAL=$GET(@FGL@("FacilitySpecificHoursOfAdministrationTiming",I,"HoursOfAdministrationValue",0))
- +10 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +11 ; sequence, hours of administration code, hours of adminstraiton qualifier, hours of adminstration text, hours of adminstration value
- +12 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=ADVAL
- SET FDA(SF,IENS,1)=ADTEXT
- SET FDA(SF,IENS,2.1)=ADQUAL
- SET FDA(SF,IENS,2.2)=ADCODE
- End DoDot:1
- +13 DO CFDA^PSOERXIU(.FDA)
- +14 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +15 QUIT
- PATNOTES(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file patient codified notes
- +1 NEW PGL,I,SEQUENCE,SF,QUAL,VALUE,IENS,FDA,SF
- +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.4931159
- +4 FOR
- SET I=$ORDER(@PGL@("PatientCodifiedNote",I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 SET SEQUENCE=SEQUENCE+1
- +6 SET QUAL=$GET(@PGL@("PatientCodifiedNote",I,"Qualifier",0))
- +7 SET VALUE=$GET(@PGL@("PatientCodifiedNote",I,"Value",0))
- +8 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +9 ; sequence, qualifier, value
- +10 ; resolving pointer
- SET QUAL=$$PRESOLV^PSOERXA1(QUAL,"PCQ")
- +11 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=QUAL
- SET FDA(SF,IENS,.03)=VALUE
- End DoDot:1
- +12 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +13 QUIT
- COMPOUND(ERXIEN,MIEN,MTYPE,MEDTYPE) ; parse and file compound ingredient information
- +1 ; create field in 52.49311 after the compound ingredients multiple. field will live outside of the loop (1 instance) - final compound pharamceutical dosage form
- +2 NEW CGL,I,SF,SEQUENCE,COMPID,DEA,INCODE,INQUAL,STRFORM,STRUOMCD,STRVAL,ACKREA,CLINSC,COAGCODE,COAGQUAL,PROFSC,REACODE,RESCODE,CLQUAL,QUOMCODE,QUANTITY,IENS,FDA
- +3 NEW SF,COAGDESC,FNLCMPDF
- +4 SET CGL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,MEDTYPE,0,"CompoundInformation",0))
- +5 SET I=-1
- SET SEQUENCE=0
- SET SF=52.4931157
- +6 FOR
- SET I=$ORDER(@CGL@("CompoundIngredientsLotNotUsed",I))
- if I=""
- QUIT
- Begin DoDot:1
- +7 SET SEQUENCE=SEQUENCE+1
- +8 SET COMPID=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"CompoundIngredientItemDescription",0))
- +9 SET DEA=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"DEASchedule",0,"Code",0))
- +10 SET INCODE=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Code",0))
- +11 SET INQUAL=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"ItemNumber",0,"Qualifier",0))
- +12 SET STRFORM=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthForm",0,"Code",0))
- +13 SET STRUOMCD=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthUnitOfMeasure",0,"Code",0))
- +14 SET STRVAL=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"CompoundIngredient",0,"Strength",0,"StrengthValue",0))
- +15 SET ACKREA=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"AcknowledgementReason",0))
- +16 SET CLINSC=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ClinicalSignificanceCode",0))
- +17 SET COAGCODE=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Code",0))
- +18 SET COAGDESC=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Description",0))
- +19 SET COAGQUAL=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"CoAgent",0,"CoAgentCode",0,"Qualifier",0))
- +20 SET PROFSC=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ProfessionalServiceCode",0))
- +21 SET REACODE=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceReasonCode",0))
- +22 SET RESCODE=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"DrugUseEvaluation",0,"ServiceResultCode",0))
- +23 SET CLQUAL=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"CodeListQualifier",0))
- +24 SET QUOMCODE=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"QuantityUnitOfMeasure",0,"Code",0))
- +25 SET QUANTITY=$GET(@CGL@("CompoundIngredientsLotNotUsed",I,"Quantity",0,"Value",0))
- +26 SET IENS="+"_SEQUENCE_","_MIEN_","_ERXIEN_","
- +27 ; sequence, comp ingredient, comp ingredient item desc, item number code, item number qualifier
- +28 ; resolving pointer
- SET INQUAL=$$PRESOLV^PSOERXA1(INQUAL,"ICQ")
- +29 SET FDA(SF,IENS,.01)=SEQUENCE
- SET FDA(SF,IENS,.02)=COMPID
- SET FDA(SF,IENS,.03)=INCODE
- SET FDA(SF,IENS,.04)=INQUAL
- +30 ; strength value, strength form, strength unit of measure, dea schedule code
- +31 ; resolving pointer
- SET STRFORM=$$PRESOLV^PSOERXA1(STRFORM,"NCI")
- +32 ; resolving pointer
- SET STRUOMCD=$$PRESOLV^PSOERXA1(STRUOMCD,"NCI")
- +33 ; resolving pointer
- SET DEA=$$PRESOLV^PSOERXA1(DEA,"NCI")
- +34 SET FDA(SF,IENS,1.1)=STRVAL
- SET FDA(SF,IENS,1.2)=STRFORM
- SET FDA(SF,IENS,1.3)=STRUOMCD
- SET FDA(SF,IENS,1.4)=DEA
- +35 ; compound quantity , compound qual, compound quantity unit of measure
- +36 ; resolving pointer
- SET CLQUAL=$$PRESOLV^PSOERXA1(CLQUAL,"QCQ")
- +37 ; resolving pointer
- SET QUOMCODE=$$PRESOLV^PSOERXA1(QUOMCODE,"NCI")
- +38 SET FDA(SF,IENS,2.1)=QUANTITY
- SET FDA(SF,IENS,2.2)=CLQUAL
- SET FDA(SF,IENS,2.3)=QUOMCODE
- +39 ; service reason code, professional service code, service result code
- +40 ; resolving pointer
- SET REACODE=$$PRESOLV^PSOERXA1(REACODE,"REA")
- +41 ; resolving pointer
- SET PROFSC=$$PRESOLV^PSOERXA1(PROFSC,"PSC")
- +42 ; resolving pointer
- SET RESCODE=$$PRESOLV^PSOERXA1(RESCODE,"RES")
- +43 SET FDA(SF,IENS,3.1)=REACODE
- SET FDA(SF,IENS,3.2)=PROFSC
- SET FDA(SF,IENS,3.3)=RESCODE
- +44 ; co-agent code, co-agent qualifier, clinical significance code, acknowledgement reason, co-agent description
- +45 ; resolving pointer
- SET COAGQUAL=$$PRESOLV^PSOERXA1(COAGQUAL,"CAQ")
- +46 SET FDA(SF,IENS,3.4)=COAGCODE
- SET FDA(SF,IENS,3.5)=COAGQUAL
- SET FDA(SF,IENS,3.6)=CLINSC
- SET FDA(SF,IENS,3.7)=ACKREA
- SET FDA(SF,IENS,4)=COAGDESC
- End DoDot:1
- +47 DO CFDA^PSOERXIU(.FDA)
- +48 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +49 SET FNLCMPDF=$GET(@CGL@("FinalCompoundPharmaceuticalDosageForm",0))
- +50 SET FNLCMPDF=$$PRESOLV^PSOERXA1(FNLCMPDF,"NCI")
- +51 SET FDA(52.49311,MIEN_","_ERXIEN_",",81)=FNLCMPDF
- DO FILE^DIE(,"FDA")
- KILL FDA
- +52 QUIT