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

PSOERXID.m

Go to the documentation of this file.
  1. PSOERXID ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,635**;DEC 1997;Build 19
  1. ;
  1. Q
  1. ALLERGY(IEN,MYTPE) ; parsing and filing into allergy multiple
  1. N AGL,I,IENS,SEQUENCE,SOI,EFFD,EXPD,ADVET,ADVEC,DPC,DPQ,DPT,RT,RC,ST,SC,FDA,NKA
  1. S AGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"AllergyOrAdverseEvent",0))
  1. S I=-1,SF=52.49303,IENS=IEN_",",SEQUENCE=0
  1. F S I=$O(@AGL@("Allergies",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S SOI=$G(@AGL@("Allergies",I,"SourceOfInformation",0))
  1. .S EFFD=$G(@AGL@("Allergies",I,"EffectiveDate",0,"Date",0))
  1. .I '$L(EFFD) S EFFD=$G(@AGL@("Allergies",I,"EffectiveDate",0,"DateTime",0))
  1. .S EFFD=$$CONVDTTM^PSOERXA1(EFFD)
  1. .S EXPD=$G(@AGL@("Allergies",I,"ExpirationDate",0,"Date",0))
  1. .I '$L(EXPD) S EXPD=$G(@AGL@("Allergies",I,"ExpirationDate",0,"DateTime",0))
  1. .S EXPD=$$CONVDTTM^PSOERXA1(EXPD)
  1. .S ADVET=$G(@AGL@("Allergies",I,"AdverseEvent",0,"Text",0))
  1. .S ADVEC=$G(@AGL@("Allergies",I,"AdverseEvent",0,"Code",0))
  1. .S DPC=$G(@AGL@("Allergies",I,"DrugProductCoded",0,"Code",0))
  1. .S DPQ=$G(@AGL@("Allergies",I,"DrugProductCoded",0,"Qualifier",0))
  1. .S DPT=$G(@AGL@("Allergies",I,"DrugProductCoded",0,"Text",0))
  1. .S RT=$G(@AGL@("Allergies",I,"ReactionCoded",0,"Text",0))
  1. .S RC=$G(@AGL@("Allergies",I,"ReactionCoded",0,"Code",0))
  1. .S ST=$G(@AGL@("Allergies",I,"SeverityCoded",0,"Text",0))
  1. .S SC=$G(@AGL@("Allergies",I,"SeverityCoded",0,"Code",0))
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,.02)=SOI ; source of information
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,.03)=EFFD ; effective date
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,.04)=EXPD ; expiration date
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,1)=DPC ; drug product code
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,2)=DPQ ; drug product qualifier
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,3)=DPT ; drug product text
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,4)=RT ; reaction text
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,5)=RC ; reaction code
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,6)=ST ; severity text
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,7)=SC ; severity code
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,8)=ADVET ; adverse event text
  1. .S FDA(SF,"+"_SEQUENCE_","_IENS,9)=ADVEC ; adverse event code
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. S NKA=$G(@AGL@("NoKnownAllergies",0)),FDA(52.49,IEN_",",302)=NKA
  1. D FILE^DIE(,"FDA")
  1. Q
  1. ;
  1. BENEFITS(IEN,MTYPE) ;parsing and filing benefits coordination data
  1. N BGL,F,SF,FDA,IENS,SEQUENCE,I,IIN,MUTDEF,NAIC,PATERID,PIN,SUHID,PATNAME,CHID,BCHGL,CARDNAME,CHLN,CHFN,CHMN,CHSUFF,CHPREF,GID
  1. N PAYRC,PATREL,PCODE,GNAME,BGLA,ADDRESS,ADL1,ADL2,CITY,POSTAL,STATE,CC,PBM,BGLN,RESPARTY,RPLN,RPFN,RPMN,RPSUFF,RPPREF,PAYTYPE
  1. N BGLC,NIEN,NEWIEN,PAYERID,PAYNAME
  1. S BGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0))
  1. S BGLC=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"BenefitsCoordination",0))
  1. S F=52.49304,SF=52.493046,IENS=IEN_",",SEQUENCE=0,I=-1
  1. F S I=$O(@BGL@("BenefitsCoordination",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S IIN=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"IINNumber",0))
  1. .S MUTDEF=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"MutuallyDefined",0))
  1. .S NAIC=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"NAICCode",0))
  1. .S PAYERID=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"PayerID",0))
  1. .S PIN=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"ProcessorIdentificationNumber",0))
  1. .S SUHID=$G(@BGL@("BenefitsCoordination",I,"PayerIdentification",0,"StandardUniqueHealthPlanIdentifier",0))
  1. .S PAYNAME=$G(@BGL@("BenefitsCoordination",I,"PayerName",0))
  1. .S CHID=$G(@BGL@("BenefitsCoordination",0,"CardholderID",I))
  1. .S BCHGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"BenefitsCoordination",I,"CardHolderName",0))
  1. .S CARDNAME=$$NAME^PSOERXIU(BCHGL)
  1. .S CHLN=$P(CARDNAME,U,1),CHFN=$P(CARDNAME,U,2),CHMN=$P(CARDNAME,U,3),CHSUFF=$P(CARDNAME,U,4),CHPREF=$P(CARDNAME,U,5)
  1. .S GID=$G(@BGL@("BenefitsCoordination",I,"GroupID",0))
  1. .S PAYRC=$G(@BGL@("BenefitsCoordination",I,"PayerResponsibilityCode",0))
  1. .S PATREL=$G(@BGL@("BenefitsCoordination",I,"PatientRelationship",0))
  1. .S PCODE=$G(@BGL@("BenefitsCoordination",I,"PersonCode",0))
  1. .S GNAME=$G(@BGL@("BenefitsCoordination",I,"GroupName",0))
  1. .S BGLA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"BenefitsCoordination",I,"Address",0))
  1. .S ADDRESS=$$ADDRESS^PSOERXIU(BGLA)
  1. .S ADL1=$P(ADDRESS,U,1),ADL2=$P(ADDRESS,U,2),CITY=$P(ADDRESS,U,3),POSTAL=$P(ADDRESS,U,5),STATE=$P(ADDRESS,U,4),CC=$P(ADDRESS,U,6)
  1. .S STATE=$$STRES^PSOERXA2(POSTAL,STATE)
  1. .S PBM=$G(@BGL@("BenefitsCoordination",I,"PBMMemberID",0))
  1. .S BGLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"BenefitsCoordination",I,"ResponsibleParty",0))
  1. .S RESPARTY=$$NAME^PSOERXIU(BGLN)
  1. .S RPLN=$P(RESPARTY,U,1),RPFN=$P(RESPARTY,U,2),RPMN=$P(RESPARTY,U,3),RPSUFF=$P(RESPARTY,U,4),RPPREF=$P(RESPARTY,U,5)
  1. .S PAYTYPE=$G(@BGL@("BenefitsCoordination",I,"PayerType",0)),PAYTYPE=$$PRESOLV^PSOERXA1(PAYTYPE,"PAY")
  1. .; sequence, payer ID, processor ID number, NAIC code
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE,FDA(F,"+"_SEQUENCE_","_IENS,.02)=PAYERID,FDA(F,"+"_SEQUENCE_","_IENS,.03)=PIN,FDA(F,"+"_SEQUENCE_","_IENS,.04)=NAIC
  1. .; mutually defined, health plan identifier, IIN number
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,1.1)=IIN,FDA(F,"+"_SEQUENCE_","_IENS,1.2)=SUHID,FDA(F,"+"_SEQUENCE_","_IENS,1.3)=IIN
  1. .; payer name, cardholder ID
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,2.1)=PAYNAME,FDA(F,"+"_SEQUENCE_","_IENS,2.2)=CHID
  1. .; cardhold name
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,3.1)=CHLN,FDA(F,"+"_SEQUENCE_","_IENS,3.2)=CHFN,FDA(F,"+"_SEQUENCE_","_IENS,3.3)=CHMN
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,3.4)=CHSUFF,FDA(F,"+"_SEQUENCE_","_IENS,3.5)=CHPREF
  1. .; group ID, payer responsibility code, patient realtionship code, person code, group name
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,4.1)=GID,FDA(F,"+"_SEQUENCE_","_IENS,4.3)=PAYRC,FDA(F,"+"_SEQUENCE_","_IENS,4.4)=PATREL
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,4.5)=PCODE,FDA(F,"+"_SEQUENCE_","_IENS,4.6)=GNAME
  1. .; address info
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,5.1)=ADL1,FDA(F,"+"_SEQUENCE_","_IENS,5.2)=ADL2,FDA(F,"+"_SEQUENCE_","_IENS,5.3)=CITY
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,5.4)=STATE,FDA(F,"+"_SEQUENCE_","_IENS,5.5)=POSTAL,FDA(F,"+"_SEQUENCE_","_IENS,5.6)=CC
  1. .; PBM member ID
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,15.1)=PBM
  1. .; responsible party name info
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,16.1)=RPLN,FDA(F,"+"_SEQUENCE_","_IENS,16.2)=RPFN,FDA(F,"+"_SEQUENCE_","_IENS,16.3)=RPMN
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,16.4)=RPSUFF,FDA(F,"+"_SEQUENCE_","_IENS,16.5)=RPPREF
  1. .; payer type
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,16.6)=PAYTYPE
  1. .D CFDA^PSOERXIU(.FDA)
  1. .D UPDATE^DIE(,"FDA","NEWIEN") K FDA
  1. .S NIEN=$O(NEWIEN(0)),NIEN=$G(NEWIEN(NIEN))
  1. .D COMM^PSOERXIU(BGLC,SF,NIEN_","_IEN,52.49304,7) ;parse and file benefits coordination communication
  1. .K NEWIEN
  1. Q
  1. FACILITY(IEN,MTYPE) ; parsing and filing facility data
  1. N FLG,FGLA,F,SF,IENS,SEQUENCE,FACNAME,NCPDPID,SLN,MEDICARE,MEDICAID,UPIN,FACID,DEA,HIN,NPI,MUTDEF,REMS,FACADD
  1. N FDA,AL1,ADL2,CITY,STATE,POSTAL,CC,FGLC,FGL,UIC
  1. S FGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0))
  1. S FGLC=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Facility",0))
  1. S FGLA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Facility",0,"Address",0))
  1. S F=52.49,SF=52.4973,IENS=IEN_",",SEQUENCE=0
  1. S FACNAME=$G(@FGL@("Facility",0,"FacilityName",0))
  1. S NCPDPID=$G(@FGL@("Facility",0,"Identification",0,"NCPDPID",0))
  1. S SLN=$G(@FGL@("Facility",0,"Identification",0,"StateLicenseNumber",0))
  1. S MEDICARE=$G(@FGL@("Facility",0,"Identification",0,"MedicareNumber",0))
  1. S MEDICAID=$G(@FGL@("Facility",0,"Identification",0,"MedicaidNumber",0))
  1. S UPIN=$G(@FGL@("Facility",0,"Identification",0,"UPIN",0))
  1. S FACID=$G(@FGL@("Facility",0,"Identification",0,"FacilityID",0))
  1. S DEA=$G(@FGL@("Facility",0,"Identification",0,"DEANumber",0))
  1. S HIN=$G(@FGL@("Facility",0,"Identification",0,"HIN",0))
  1. S NPI=$G(@FGL@("Facility",0,"Identification",0,"NPI",0))
  1. S MUTDEF=$G(@FGL@("Facility",0,"Identification",0,"MutuallyDefined",0))
  1. S REMS=$G(@FGL@("Facility",0,"Identification",0,"REMSHealthcareSettingEnrollmentID",0))
  1. S FACADD=$$ADDRESS^PSOERXIU(FGLA)
  1. S ADL1=$P(FACADD,U,1),ADL2=$P(FACADD,U,2),CITY=$P(FACADD,U,3),POSTAL=$P(FACADD,U,5),STATE=$P(FACADD,U,4),CC=$P(FACADD,U,6)
  1. S STATE=$$STRES^PSOERXA2(POSTAL,STATE)
  1. ;facility name and address data
  1. S FDA(F,IENS,70.1)=FACNAME,FDA(F,IENS,70.2)=ADL1,FDA(F,IENS,70.3)=ADL2,FDA(F,IENS,70.4)=CITY
  1. S FDA(F,IENS,70.5)=STATE,FDA(F,IENS,70.6)=POSTAL,FDA(F,IENS,70.7)=CC
  1. ;facility ID
  1. S FDA(F,IENS,74.1)=NCPDPID,FDA(F,IENS,74.2)=SLN,FDA(F,IENS,74.3)=MEDICARE,FDA(F,IENS,74.4)=MEDICAID
  1. S FDA(F,IENS,74.5)=UPIN,FDA(F,IENS,74.6)=FACID,FDA(F,IENS,75.1)=DEA,FDA(F,IENS,75.2)=HIN
  1. S FDA(F,IENS,75.3)=NPI,FDA(F,IENS,75.4)=MUTDEF,FDA(F,IENS,75.5)=REMS
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. D COMM^PSOERXIU(FGLC,SF,IEN,52.49,76) ; parse and file facility communication data
  1. Q
  1. OBSERV(IEN,MTYPE) ; parsing and filing observation data
  1. N OGL,I,F,IENS,SEQUENCE,VSIGN,LOIN,VALUE,UOM,UCUM,OBDATE,FDA,OBNOTES,LGL,LTCLOC,PROREN
  1. S OGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Observation",0))
  1. S I=-1,F=52.49306,IENS=IEN_",",SEQUENCE=0
  1. F S I=$O(@OGL@("Measurement",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S VSIGN=$G(@OGL@("Measurement",I,"VitalSign",0))
  1. .S LOIN=$G(@OGL@("Measurement",I,"LOINCVersion",0))
  1. .S VALUE=$G(@OGL@("Measurement",I,"Value",0))
  1. .S UOM=$G(@OGL@("Measurement",I,"UnitOfMeasure",0))
  1. .S UCUM=$G(@OGL@("Measurement",I,"UCUMVersion",0))
  1. .S OBDATE=$G(@OGL@("Measurement",I,"ObservationDate",0,"Date",0))
  1. .;PSO*7*635 - check DateTime if Date was not passed in (at least one is required for the observation)
  1. .I '$L(OBDATE) S OBDATE=$G(@OGL@("Measurement",I,"ObservationDate",0,"DateTime",0))
  1. .S OBDATE=$$CONVDTTM^PSOERXA1(OBDATE)
  1. .; sequence, vital sign, LOINCVersion, value, unit of measure, UCUM version, Observation date
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE,FDA(F,"+"_SEQUENCE_","_IENS,1)=VSIGN,FDA(F,"+"_SEQUENCE_","_IENS,2)=LOIN,FDA(F,"+"_SEQUENCE_","_IENS,3)=VALUE
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,4)=UOM,FDA(F,"+"_SEQUENCE_","_IENS,5)=UCUM,FDA(F,"+"_SEQUENCE_","_IENS,6)=OBDATE
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. S OBNOTES=$G(@OGL@("ObservationNotes",0))
  1. S LGL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0))
  1. S LTCLOC=$G(@LGL@("MessageRequestCode",0))
  1. ;/JSG/ PSO*7.0*581 - BEGIN CHANGE (Fix Prohibit Renewal Request)
  1. S PROREN=$G(@LGL@("ProhibitRenewalRequest",0))
  1. S PROREN=$S(PROREN="true":1,PROREN="false":0,1:"")
  1. ;/JSG/ - END CHANGE
  1. S UIC=$G(@LGL@("UrgencyIndicatorCode",0))
  1. S FDA(52.49,IEN_",",301.1)=LTCLOC,FDA(52.49,IEN_",",301.2)=UIC,FDA(52.49,IEN_",",301.3)=PROREN
  1. S FDA(52.49,IEN_",",305)=OBNOTES
  1. D CFDA^PSOERXIU(.FDA)
  1. D FILE^DIE(,"FDA") K FDA
  1. Q