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

PSOERXOB.m

Go to the documentation of this file.
PSOERXOB ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
 ;
 Q
OBENEFIT(GBL,CNT,ERXIEN) ;outbound benefits coordination section
 N F,BIEN,SGBL,BDAT,PAYERID,PROCID,NAIC,MUTDEF,PHID,IIN,PAYNAME,CHID,CHLN,CHFN,CHMN,CHSUFF
 N GROUPID,PAYRCODE,PATRCODE,PERCODE,GNAME,ADL1,ADL2,CITY,STATE,HPID
 N POSTAL,CC,PBMID,RPLN,RPFN,RPMN,RPSUFF,RPPREF,PAYTYPE,BIENS,CHPREF
 S F=52.49304
 I '$O(^PS(52.49,ERXIEN,304,0)) Q
 S BIEN=0 F  S BIEN=$O(^PS(52.49,ERXIEN,304,BIEN)) Q:'BIEN  D
 .K BDAT
 .S BIENS=BIEN_","_ERXIEN_","
 .D GETS^DIQ(F,BIENS,"**","IE","BDAT")
 .S PAYERID=$G(BDAT(F,BIENS,.02,"E"))
 .S PROCID=$G(BDAT(F,BIENS,.03,"E"))
 .S NAIC=$G(BDAT(F,BIENS,.04,"E"))
 .S MUTDEF=$G(BDAT(F,BIENS,1.1,"E"))
 .S HPID=$G(BDAT(F,BIENS,1.2,"E"))
 .S IIN=$G(BDAT(F,BIENS,1.3,"E"))
 .S PAYNAME=$G(BDAT(F,BIENS,2.1,"E"))
 .S CHID=$G(BDAT(F,BIENS,2.2,"E"))
 .S CHLN=$G(BDAT(F,BIENS,3.1,"E"))
 .S CHFN=$G(BDAT(F,BIENS,3.2,"E"))
 .S CHMN=$G(BDAT(F,BIENS,3.3,"E"))
 .S CHSUFF=$G(BDAT(F,BIENS,3.4,"E"))
 .S CHPREF=$G(BDAT(F,BIENS,3.5,"E"))
 .S GROUPID=$G(BDAT(F,BIENS,4.1,"E"))
 .S PAYRCODE=$G(BDAT(F,BIENS,4.3,"I"))
 .S PATRCODE=$G(BDAT(F,BIENS,4.4,"I"))
 .S PERCODE=$G(BDAT(F,BIENS,4.5,"E"))
 .S GNAME=$G(BDAT(F,BIENS,4.6,"E"))
 .S ADL1=$G(BDAT(F,BIENS,5.1,"E"))
 .S ADL2=$G(BDAT(F,BIENS,5.2,"E"))
 .S CITY=$G(BDAT(F,BIENS,5.3,"E"))
 .S STATE=$G(BDAT(F,BIENS,5.4,"I"))
 .S POSTAL=$G(BDAT(F,BIENS,5.5,"E"))
 .S CC=$G(BDAT(F,BIENS,5.6,"E"))
 .S PBMID=$G(BDAT(F,BIENS,15.1,"E"))
 .S RPLN=$G(BDAT(F,BIENS,16.1,"E"))
 .S RPFN=$G(BDAT(F,BIENS,16.2,"E"))
 .S RPMN=$G(BDAT(F,BIENS,16.3,"E"))
 .S RPSUFF=$G(BDAT(F,BIENS,16.4,"E"))
 .S RPPREF=$G(BDAT(F,BIENS,16.5,"E"))
 .S PAYTYPE=$G(BDAT(F,BIENS,16.6,"E"))
 .D C S @GBL@(CNT,0)="<BenefitsCoordination>"
 .I $L(PAYERID_PROCID_NAIC_MUTDEF_HPID_IIN) D
 ..D C S @GBL@(CNT,0)="<PayerIdentification>"
 ..D BL(GBL,.CNT,"PayerID",PAYERID)
 ..D BL(GBL,.CNT,"ProcessorIdentificationNumber",PROCID)
 ..D BL(GBL,.CNT,"NAICCode",NAIC)
 ..D BL(GBL,.CNT,"MutuallyDefined",MUTDEF)
 ..D BL(GBL,.CNT,"StandardUniqueHealthPlanIdentifier",HPID)
 ..D BL(GBL,.CNT,"IINNumber",IIN)
 ..D C S @GBL@(CNT,0)="</PayerIdentification>"
 .D BL(GBL,.CNT,"PayerName",PAYNAME)
 .D BL(GBL,.CNT,"CardholderID",CHID)
 .D ONAME^PSOERXOU(GBL,.CNT,"CardHolderName",CHLN,CHFN,CHMN,CHSUFF,CHPREF)
 .D BL(GBL,.CNT,"GroupID",GROUPID)
 .D BL(GBL,.CNT,"PayerResponsibilityCode",PAYRCODE)
 .D BL(GBL,.CNT,"PatientRelationshipCode",PATRCODE)
 .D BL(GBL,.CNT,"PersonCode",PERCODE)
 .D BL(GBL,.CNT,"GroupName",GNAME)
 .D OADD^PSOERXOU(GBL,.CNT,ADL1,ADL2,CITY,STATE,POSTAL,CC)
 .S SGBL=$NA(^PS(52.49,ERXIEN,304,BIEN,6))
 .D OCOMM^PSOERXOU(GBL,SGBL,.CNT,BIEN_","_ERXIEN_",",52.493046,52.49304,7,BIEN_","_ERXIEN_",")
 .;D BL(GBL,.CNT,"PBMMemberID",PBMID)
 .D ONAME^PSOERXOU(GBL,.CNT,"ResponsibleParty",RPLN,RPFN,RPMN,RPSUFF,RPPREF)
 .D BL(GBL,.CNT,"PayerType",PAYTYPE)
 .D C S @GBL@(CNT,0)="</BenefitsCoordination>"
 Q
OALLERGY(GBL,CNT,ERXIEN) ;outbound allergy segment
 N AIEN,ADAT,AIENS,SOI,EFFDATE,EXPDATE,DPC,DPQ,DPT
 N REATEXT,REACODE,SEVTEXT,SEVCODE,ADVTEXT,ADVCODE
 S F=52.49303
 I '$O(^PS(52.49,ERXIEN,303,0)) D  Q
 .S NKA=$$GET1^DIQ(52.49,ERXIEN,302,"I")
 .D C S @GBL@(CNT,0)="<AllergyOrAdverseEvent>"
 .D BL(GBL,.CNT,"NoKnownAllergies",NKA)
 .D C S @GBL@(CNT,0)="</AllergyOrAdverseEvent>"
 I $O(^PS(52.49,ERXIEN,303,0)) D
 .D C S @GBL@(CNT,0)="<AllergyOrAdverseEvent>"
 S AIEN=0 F  S AIEN=$O(^PS(52.49,ERXIEN,303,AIEN)) Q:'AIEN  D
 .K ADAT
 .S AIENS=AIEN_","_ERXIEN_","
 .D GETS^DIQ(F,AIENS,"**","IE","ADAT")
 .S SOI=$G(ADAT(F,AIENS,.02,"I"))
 .S EFFDATE=$G(ADAT(F,AIENS,.03,"I")) I $G(EFFDATE) S EFFDATE=$P($$EXTIME^PSOERXO1(EFFDATE),"T")
 .S EXPDATE=$G(ADAT(F,AIENS,.04,"I")) I $G(EXPDATE) S EXPDATE=$P($$EXTIME^PSOERXO1(EXPDATE),"T")
 .S DPC=$G(ADAT(F,AIENS,1,"E"))
 .S DPQ=$G(ADAT(F,AIENS,2,"E"))
 .S DPT=$G(ADAT(F,AIENS,3,"E"))
 .S REATEXT=$G(ADAT(F,AIENS,4,"E"))
 .S REACODE=$G(ADAT(F,AIENS,5,"E"))
 .S SEVTEXT=$G(ADAT(F,AIENS,6,"E"))
 .S SEVCODE=$G(ADAT(F,AIENS,7,"E"))
 .S ADVTEXT=$G(ADAT(F,AIENS,8,"E"))
 .S ADVCODE=$G(ADAT(F,AIENS,9,"E"))
 .D C S @GBL@(CNT,0)="<Allergies>"
 .D BL(GBL,.CNT,"SourceOfInformation",SOI)
 .I $L(EFFDATE) D
 ..D C S @GBL@(CNT,0)="<EffectiveDate>"
 ..D BL(GBL,.CNT,"Date",EFFDATE)
 ..D C S @GBL@(CNT,0)="</EffectiveDate>"
 .I $L(EXPDATE) D
 ..D C S @GBL@(CNT,0)="<ExpirationDate>"
 ..D BL(GBL,.CNT,"Date",EXPDATE)
 ..D C S @GBL@(CNT,0)="</ExpirationDate>"
 .D C S @GBL@(CNT,0)="<AdverseEvent>"
 .D BL(GBL,.CNT,"Text",ADVTEXT)
 .D BL(GBL,.CNT,"Code",ADVCODE)
 .D C S @GBL@(CNT,0)="</AdverseEvent>"
 .D C S @GBL@(CNT,0)="<DrugProductCoded>"
 .D BL(GBL,.CNT,"Code",DPC)
 .D BL(GBL,.CNT,"Qualifier",DPQ)
 .D BL(GBL,.CNT,"Text",DPT)
 .D C S @GBL@(CNT,0)="</DrugProductCoded>"
 .I $L(REATEXT_REACODE) D
 ..D C S @GBL@(CNT,0)="<ReactionCoded>"
 ..D BL(GBL,.CNT,"Text",REATEXT)
 ..D BL(GBL,.CNT,"Code",REACODE)
 ..D C S @GBL@(CNT,0)="</ReactionCoded>"
 .I $L(SEVTEXT_SEVCODE) D
 ..D C S @GBL@(CNT,0)="<SeverityCoded>"
 ..D BL(GBL,.CNT,"Text",SEVTEXT)
 ..D BL(GBL,.CNT,"Code",SEVCODE)
 ..D C S @GBL@(CNT,0)="</SeverityCoded>"
 .D C S @GBL@(CNT,0)="</Allergies>"
 D C S @GBL@(CNT,0)="</AllergyOrAdverseEvent>"
 Q
OFAC(GBL,CNT,ERXIEN) ;outbound facility segment
 N F,IENS,NCPDPID,STATELIC,MEDICARE,MEDICAID,UPIN,ID,DEA,HIM,NPE,MUTDEF,RESMID
 N FACNAME,ADL1,ADL2,CITY,STATE,POSTAL,CC,FACDAT,HIN,NKA,NPI,REMSID
 S F=52.49
 S IENS=ERXIEN_","
 D GETS^DIQ(F,IENS,"74.1;74.2;74.3;74.4;74.5;74.6;75.1;75.2;75.3;75.4;75.5;70.1;70.2;70.3;70.4;70.5;70.6;70.7","E","FACDAT")
 S NCPDPID=$G(FACDAT(F,IENS,74.1,"E"))
 S STATELIC=$G(FACDAT(F,IENS,74.2,"E"))
 S MEDICARE=$G(FACDAT(F,IENS,74.3,"E"))
 S MEDICAID=$G(FACDAT(F,IENS,74.4,"E"))
 S UPIN=$G(FACDAT(F,IENS,74.5,"E"))
 S ID=$G(FACDAT(F,IENS,74.6,"E"))
 S DEA=$G(FACDAT(F,IENS,75.1,"E"))
 S HIN=$G(FACDAT(F,IENS,75.2,"E"))
 S NPI=$G(FACDAT(F,IENS,75.3,"E"))
 S MUTDEF=$G(FACDAT(F,IENS,75.4,"E"))
 S REMSID=$G(FACDAT(F,IENS,75.5,"E"))
 S FACNAME=$G(FACDAT(F,IENS,70.1,"E"))
 S ADL1=$G(FACDAT(F,IENS,70.2,"E"))
 S ADL2=$G(FACDAT(F,IENS,70.3,"E"))
 S CITY=$G(FACDAT(F,IENS,70.4,"E"))
 S STATE=$G(FACDAT(F,IENS,70.5,"I"))
 S POSTAL=$G(FACDAT(F,IENS,70.6,"E"))
 S CC=$G(FACDAT(F,IENS,70.7,"E"))
 I $L(NCPDPID_STATELIC_MEDICARE_MEDICAID_UPIN_ID_DEA_HIN_NPI_MUTDEF_REMSID) D
 .D C S @GBL@(CNT,0)="<Facility>"
 .D C S @GBL@(CNT,0)="<Identification>"
 .D BL(GBL,.CNT,"NCPDPIP",NCPDPID)
 .D BL(GBL,.CNT,"StateLicenseNumber",STATELIC)
 .D BL(GBL,.CNT,"MedicareNumber",MEDICARE)
 .D BL(GBL,.CNT,"MedicaidNumber",MEDICAID)
 .D BL(GBL,.CNT,"UPIN",UPIN)
 .D BL(GBL,.CNT,"FacilityID",ID)
 .D BL(GBL,.CNT,"DEANumber",DEA)
 .D BL(GBL,.CNT,"HIN",HIN)
 .D BL(GBL,.CNT,"NPI",NPI)
 .D BL(GBL,.CNT,"MutuallyDefined",MUTDEF)
 .D BL(GBL,.CNT,"REMSHealthcareSettingEnrollmentID",REMSID)
 .D C S @GBL@(CNT,0)="</Identification>"
 .D BL(GBL,.CNT,"FacilityName",FACNAME)
 .D OADD^PSOERXOU(GBL,.CNT,ADL1,ADL2,CITY,STATE,POSTAL,CC)
 .S SGBL=$NA(^PS(52.49,ERXIEN,73))
 .D OCOMM^PSOERXOU(GBL,SGBL,.CNT,ERXIEN_",",52.4973,52.49,76,ERXIEN_",")
 .D C S @GBL@(CNT,0)="</Facility>"
 Q
OOBSERVE(GL,CNT,ERXIEN) ;outbound observation segment
 N OIEN,OIENS,ODAT,VITAL,LOINC,VALUE,UOM,UCUM,OBDATE,OBNOTE
 Q:'$O(^PS(52.49,ERXIEN,306,0))
 D C S @GBL@(CNT,0)="<Observation>"
 S OIEN=0 F  S OIEN=$O(^PS(52.49,ERXIEN,306,OIEN)) Q:'OIEN  D
 .S F=52.49306
 .K ODAT
 .S OIENS=OIEN_","_ERXIEN_","
 .D GETS^DIQ(F,OIENS,"**","IE","ODAT")
 .S VITAL=$G(ODAT(F,OIENS,1,"E"))
 .S LOINC=$G(ODAT(F,OIENS,2,"E"))
 .S VALUE=$G(ODAT(F,OIENS,3,"E"))
 .S UOM=$G(ODAT(F,OIENS,4,"E"))
 .S UCUM=$G(ODAT(F,OIENS,5,"E"))
 .S OBDATE=$G(ODAT(F,OIENS,6,"I")) I $G(OBDATE) S OBDATE=$P($$EXTIME^PSOERXO1(OBDATE),"T")
 .I $L(VITAL_LOINC_VALUE_UOM_UCUM) D
 ..D C S @GBL@(CNT,0)="<Measurement>"
 ..D BL(GBL,.CNT,"VitalSign",VITAL)
 ..D BL(GBL,.CNT,"LOINCVersion",LOINC)
 ..D BL(GBL,.CNT,"Value",VALUE)
 ..D BL(GBL,.CNT,"UnitOfMeasure",UOM)
 ..D BL(GBL,.CNT,"UCUMVersion",UCUM)
 ..I $L(OBDATE) D
 ...D C S @GBL@(CNT,0)="<ObservationDate>"
 ...D BL(GBL,.CNT,"Date",OBDATE)
 ...D C S @GBL@(CNT,0)="</ObservationDate>"
 ..D C S @GBL@(CNT,0)="</Measurement>"
 S OBNOTE=$$GET1^DIQ(52.49,ERXIEN,305,"E")
 D BL(GBL,.CNT,"ObservationNotes",OBNOTE)
 D C S @GBL@(CNT,0)="</Observation>"
 Q
BL(GBL,CNT,TAG,VAR) ;
 Q:VAR=""
 D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
 Q
C ;
 S CNT=$G(CNT)+1
 Q