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

PSOERXIA.m

Go to the documentation of this file.
  1. PSOERXIA ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,700,746**;DEC 1997;Build 106
  1. ;
  1. Q
  1. PAT(ERXIEN,MTYPE) ; patient
  1. N F,EIENS,GL,GLN,GLFN,GLALT,GLFALT,MEDICARE,MEDICAID,MRID,PATACC,PATSSN,MUTDEF,REMPATID,PATNAME,LN,FN,MN,SUFF,PREF,PFN,FPATNAME
  1. N FLN,FFN,FMN,FSUFF,FPREF,GEN,DOB,ADDINFO,AL1,LOCFAC,LOCBED,LOCROOM,LANGNC,ALTNM,ALTLN,ALTFN,ALTMN,ALTSUFF,ALTPREF,FALTNM,FALTLN
  1. N FALTFN,FALTMN,FALTSUFF,FALTPREF,ALTADD,ALTAL1,ALTAL2,ALTCITY,ALTSTATE,ALTPOST,ALTCC,ALTCONRE,GESTAGE,HOSPIND,SIEN,ERXPAT,PIENS
  1. N NPIEN,FDA,NEWPAT,SPEC,GLPADD,GLALTNM,GLALTADD,AL2,CC,CITY,GLALTAD,POSTAL,STATE
  1. S F=52.46
  1. S EIENS=ERXIEN_","
  1. S SPEC=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,""))
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0))
  1. S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Name",0))
  1. S GLFN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"FormerName",0))
  1. S GLALT=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0))
  1. S GLALTNM=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Name",0))
  1. S GLALTAD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Address",0))
  1. S GLFALT=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"FormerName",0))
  1. S GLPADD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Address",0))
  1. S MEDICARE=$G(@GL@("Identification",0,"MedicareNumber",0))
  1. S MEDICAID=$G(@GL@("Identification",0,"MedicaidNumber",0))
  1. S MRID=$G(@GL@("Identification",0,"MedicalRecordIdentificationNumberEHR",0))
  1. S PATACC=$G(@GL@("Identification",0,"PatientAccountNumber",0))
  1. S PATSSN=$G(@GL@("Identification",0,"SocialSecurity",0))
  1. S MUTDEF=$G(@GL@("Identification",0,"MutuallyDefined",0))
  1. S REMPATID=$G(@GL@("Identification",0,"REMSPatientID",0))
  1. S PATNAME=$$NAME^PSOERXIU(GLN)
  1. S LN=$P(PATNAME,U,1),FN=$P(PATNAME,U,2),MN=$P(PATNAME,U,3),SUFF=$P(PATNAME,U,4),PREF=$P(PATNAME,U,5)
  1. S PFN=LN_","_FN_$S(MN]"":" "_MN,1:"")
  1. S FPATNAME=$$NAME^PSOERXIU(GLFN)
  1. S FLN=$P(FPATNAME,U,1),FFN=$P(FPATNAME,U,2),FMN=$P(FPATNAME,U,3),FSUFF=$P(FPATNAME,U,4),FPREF=$P(FPATNAME,U,5)
  1. S GEN=$G(@GL@("Gender",0))
  1. S DOB=$G(@GL@("DateOfBirth",0,"Date",0))
  1. I '$L(DOB) S DOB=$G(@GL@("DateOfBirth",0,"DateTime",0))
  1. S DOB=$$CONVDTTM^PSOERXA1(DOB)
  1. I DOB<1 S DOB=""
  1. S ADDINFO=$$ADDRESS^PSOERXIU(GLPADD)
  1. S AL1=$P(ADDINFO,U,1),AL2=$P(ADDINFO,U,2),CITY=$P(ADDINFO,U,3),POSTAL=$P(ADDINFO,U,5),STATE=$P(ADDINFO,U,4),CC=$P(ADDINFO,U,6)
  1. S STATE=$$STRES^PSOERXA2(POSTAL,STATE)
  1. S LOCFAC=$G(@GL@("PatientLocation",0,"FacilityUnit",0))
  1. S LOCBED=$G(@GL@("PatientLocation",0,"Bed",0))
  1. S LOCROOM=$G(@GL@("PatientLocation",0,"Room",0))
  1. S LANGNC=$G(@GL@("LanguageNameCode",0))
  1. S ALTNM=$$NAME^PSOERXIU(GLALTNM)
  1. S ALTLN=$P(ALTNM,U,1),ALTFN=$P(ALTNM,U,2),ALTMN=$P(ALTNM,U,3),ALTSUFF=$P(ALTNM,U,4),ALTPREF=$P(ALTNM,U,5)
  1. S FALTNM=$$NAME^PSOERXIU(GLFALT)
  1. S FALTLN=$P(FALTNM,U,1),FALTFN=$P(FALTNM,U,2),FALTMN=$P(FALTNM,U,3),FALTSUFF=$P(ALTNM,U,4),FALTPREF=$P(FALTNM,U,5)
  1. S ALTADD=$$ADDRESS^PSOERXIU(GLALTAD)
  1. S ALTAL1=$P(ALTADD,U,1),ALTAL2=$P(ALTADD,U,2),ALTCITY=$P(ALTADD,U,3),ALTPOST=$P(ALTADD,U,5),ALTSTATE=$P(ALTADD,U,4),ALTCC=$P(ALTADD,U,6)
  1. S ALTSTATE=$$STRES^PSOERXA2(ALTPOST,ALTSTATE)
  1. S ALTCONRE=$G(@GL@("AlternateContact",0,"AlternateContactRelationship",0)) ;***need field***
  1. S GESTAGE=$G(@GL@("GestationalAge",0))
  1. S HOSPIND=$G(@GL@("HospiceIndicator",0))
  1. ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
  1. ; check 52.46 for a match before filing
  1. S ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$G(PATSSN),$G(AL1)) S PIENS=$S(ERXPAT:ERXPAT_",",1:"+1,")
  1. ;patient name info
  1. S FDA(F,PIENS,.01)=PFN,FDA(F,PIENS,.02)=LN,FDA(F,PIENS,.03)=FN,FDA(F,PIENS,.04)=MN,FDA(F,PIENS,.05)=SUFF,FDA(F,PIENS,.06)=PREF
  1. ;patient date of birth, gender
  1. S FDA(F,PIENS,.07)=GEN,FDA(F,PIENS,.08)=DOB
  1. ;patient address info
  1. S FDA(F,PIENS,3.1)=AL1,FDA(F,PIENS,3.2)=AL2,FDA(F,PIENS,3.3)=CITY,FDA(F,PIENS,3.4)=STATE,FDA(F,PIENS,3.5)=POSTAL,FDA(F,PIENS,1.6)=CC
  1. ;former name
  1. S FDA(F,PIENS,7.1)=$G(FLN),FDA(F,PIENS,7.2)=$G(FFN),FDA(F,PIENS,7.3)=$G(FMN),FDA(F,PIENS,7.4)=$G(FSUFF),FDA(F,PIENS,7.5)=$G(FPREF)
  1. ;patient location
  1. S FDA(F,PIENS,8.1)=$G(LOCFAC),FDA(F,PIENS,8.2)=$G(LOCROOM),FDA(F,PIENS,8.3)=$G(LOCBED)
  1. ;language name code, gestational age, hospice indicator
  1. S FDA(F,PIENS,8.4)=$G(LANGNC),FDA(F,PIENS,8.5)=$G(GESTAGE),FDA(F,PIENS,8.6)=$G(HOSPIND)
  1. ;alternate contact name
  1. S FDA(F,PIENS,9.1)=$G(ALTLN),FDA(F,PIENS,9.2)=$G(ALTFN),FDA(F,PIENS,9.3)=$G(ALTMN),FDA(F,PIENS,9.4)=$G(ALTSUFF),FDA(F,PIENS,9.5)=$G(ALTPREF)
  1. ;alternate contact relationship
  1. I $L(ALTCONRE) S FDA(F,PIENS,9.6)=$$PRESOLV^PSOERXA1($G(ALTCONRE),"ACR")
  1. ;alternate contact former name
  1. S FDA(F,PIENS,10.1)=$G(FALTLN),FDA(F,PIENS,10.2)=$G(FALTFN),FDA(F,PIENS,10.3)=$G(FALTMN),FDA(F,PIENS,10.4)=$G(FALTSUFF),FDA(F,PIENS,10.5)=$G(FALTPREF)
  1. ;alt contact address info
  1. S FDA(F,PIENS,11.1)=$G(ALTAL1),FDA(F,PIENS,11.2)=$G(ALTAL2),FDA(F,PIENS,11.3)=$G(ALTCITY),FDA(F,PIENS,11.4)=$G(ALTSTATE)
  1. S FDA(F,PIENS,11.5)=$G(ALTPOST),FDA(F,PIENS,11.6)=$G(ALTCC)
  1. ;identification
  1. S FDA(F,PIENS,17.1)=$G(MEDICARE),FDA(F,PIENS,17.2)=$G(MEDICAID),FDA(F,PIENS,17.3)=MRID
  1. S FDA(F,PIENS,18.1)=$G(PATACC),FDA(F,PIENS,18.2)=$G(PATSSN),FDA(F,PIENS,18.3)=$G(MUTDEF),FDA(F,PIENS,18.4)=$G(REMPATID)
  1. ; dual file SSN into old field to trigger the SSN cross reference to be built.
  1. S FDA(F,PIENS,1.4)=$G(PATSSN)
  1. I PIENS["+" D Q
  1. .D CFDA^PSOERXIU(.FDA)
  1. .D UPDATE^DIE(,"FDA","NEWPAT") K FDA
  1. .S NPIEN=$O(NEWPAT(0)),NPIEN=$G(NEWPAT(NPIEN))
  1. .Q:'NPIEN
  1. .S NPIEN=NPIEN
  1. .D COMM^PSOERXIU(GL,52.4613,NPIEN,52.46,14) ;patient communication
  1. .N IENS S IENS=NPIEN_"," ;P700
  1. .D KILL(52.46,IENS,"15*")
  1. .S ARRAY(52.46,IENS,16)="@"
  1. .D UPDATE^DIE(,"ARRAY") K ARRAY
  1. .D COMM^PSOERXIU(GLALT,52.4615,NPIEN,52.46,16) ;alternate contact communication
  1. .D SUB(GL,NPIEN_",") ;patient substances
  1. .S FDA(52.49,EIENS,.04)=NPIEN D FILE^DIE(,"FDA") K FDA
  1. N IENS S IENS=ERXPAT_"," ;P700
  1. D KILL(52.46,IENS,"13*")
  1. S ARRAY(52.46,IENS,14)="@"
  1. D UPDATE^DIE(,"ARRAY") K ARRAY
  1. D CFDA^PSOERXIU(.FDA)
  1. D FILE^DIE(,"FDA") K FDA
  1. D COMM^PSOERXIU(GL,52.4613,ERXPAT,52.46,14)
  1. D COMM^PSOERXIU(GLALT,52.4615,ERXPAT,52.46,16)
  1. D SUB(GL,PIENS)
  1. S FDA(52.49,EIENS,.04)=ERXPAT D FILE^DIE(,"FDA") K FDA
  1. Q
  1. KILL(FILE,IENS,NODE) ;P700 creating tag to delete entries using FileMan
  1. D GETS^DIQ(FILE,IENS,NODE,,"ARRAY")
  1. S (ARFILE,ARIENS)=""
  1. F S ARFILE=$O(ARRAY(ARFILE)) Q:'ARFILE D
  1. . F S ARIENS=$O(ARRAY(ARFILE,ARIENS)) Q:'ARIENS D
  1. . . S ARRAY(ARFILE,ARIENS,.01)="@"
  1. D UPDATE^DIE(,"ARRAY") K ARRAY
  1. Q
  1. ;
  1. SUB(GL,IENS) ; parsing and filing into substance multiple ***should we replace or update??? TO DO - CLEAR OUT OR MATCH/UPDATE
  1. N SUBSEQ,SF,SUBTT,SUBTQ,SUBTC,SUBLT,SUBLQ,SUBLC,ROAT,ROAQ,ROAC,FDA,I,SIENS
  1. S SUBSEQ=0,SF=52.4619
  1. S I=-1 F S I=$O(@GL@("SubstanceUse",0,"Substance",I)) Q:I="" D
  1. .S SUBSEQ=$G(SUBSEQ)+1
  1. .S SUBTT=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Text",0))
  1. .S SUBTQ=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Qualifier",0))
  1. .S SUBTC=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Code",0))
  1. .S SUBLT=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Text",0))
  1. .S SUBLQ=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Qualifier",0))
  1. .S SUBLC=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Code",0))
  1. .S ROAT=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Text",0))
  1. .S ROAQ=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Qualifier",0))
  1. .S ROAC=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Code",0))
  1. .S SIENS="+"_SUBSEQ_","_IENS
  1. .S FDA(SF,SIENS,.01)=$G(SUBSEQ),FDA(SF,SIENS,1)=$G(SUBTT),FDA(SF,SIENS,2)=$G(SUBTQ),FDA(SF,SIENS,3)=$G(SUBTC)
  1. .S FDA(SF,SIENS,4)=$G(SUBLT),FDA(SF,SIENS,5)=$G(SUBLQ),FDA(SF,SIENS,6)=$G(SUBLC)
  1. .S FDA(SF,SIENS,7)=$G(ROAT),FDA(SF,SIENS,8)=$G(ROAQ),FDA(SF,SIENS,9)=$G(ROAC)
  1. D CFDA^PSOERXIU(.FDA)
  1. D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. CHMESREQ(ERXIEN,MTYPE) ; message request code(s) for change request
  1. N GL,MRCODE,RETREC,REQREFNM,URGIND,GLVAL,RESTYPE,MREQCODE,CHGL,SEQUENCE,FDA,I,GLV,GLVAL,CHRES,STATELIC,MEDICARE,MEDICAID,UPIN
  1. N DEA,HIM,SOCSEC,NPI,CERTPRES,DATA2000,MUTDEF,REMSID,STSUBNUM,NOTE,DATE,SPECIALTY,FILE,GLE,HIN,MRSC,RESTNODE,RESTUP,EXTRCODE,REATXT
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0))
  1. S (MREQCODE,EXTRCODE)=$G(@GL@(MTYPE,0,"MessageRequestCode",0))
  1. S MREQCODE=$$PRESOLV^PSOERXA1(MREQCODE,"MRC")
  1. S FDA(52.49,ERXIEN_",",315.1)=MREQCODE
  1. D FILE^DIE(,"FDA") K FDA
  1. S I=-1,F=52.49316,IENS=ERXIEN_",",SEQUENCE=0
  1. F S I=$O(@GL@(MTYPE,0,"MessageRequestSubCode",I)) Q:I="" D
  1. .S SEQUENCE=SEQUENCE+1
  1. .S MRSC=$G(@GL@(MTYPE,0,"MessageRequestSubCode",I))
  1. .S MRSC=$$PRESOLV^PSOERXA1(MRSC,$S(EXTRCODE="U":"MRSC",1:"REA"))
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE
  1. .S FDA(F,"+"_SEQUENCE_","_IENS,1)=MRSC
  1. D UPDATE^DIE(,"FDA") K FDA
  1. S REATXT(1,0)=$G(@GL@(MTYPE,0,"ChangeReasonText",0))
  1. I $G(REATXT(1,0))'="" D
  1. . S FDA(52.49,ERXIEN_",",317)="REATXT"
  1. . D UPDATE^DIE("","FDA")
  1. I MTYPE="RxChangeRequest" Q
  1. S GLVAL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0))
  1. S RESTYPE=$O(@GLVAL@("")),RESTUP=$$UP^XLFSTR(RESTYPE),RESTUP=$TR(RESTUP," ",""),RESTUP=$TR(RESTUP,",","")
  1. S RESTNODE=RESTYPE
  1. S RESTYPE=$S(RESTUP="VALIDATED":"V","APPROVED":"A",RESTUP="DENIED":"D",RESTUP="APPROVEDWITHCHANGES":"AWC",1:"")
  1. ; ADD SECOND CHECK FOR DATA
  1. I RESTYPE="V" D
  1. .S CHRES=1
  1. .S FILE=52.49
  1. .S GLV=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,"Identification",0))
  1. .S STATELIC=$G(@GLV@("StateLicenseNumber",0))
  1. .S MEDICARE=$G(@GLV@("MedicareNumber",0))
  1. .S MEDICAID=$G(@GLV@("MedicaidNumber",0))
  1. .S UPIN=$G(@GLV@("UPIN",0))
  1. .S DEA=$G(@GLV@("DEANumber",0))
  1. .S HIN=$G(@GLV@("HIN",0))
  1. .S SOCSEC=$G(@GLV@("SocialSecurity",0))
  1. .S NPI=$G(@GLV@("NPI",0))
  1. .S CERTPRES=$G(@GLV@("CertificateToPrescribe",0))
  1. .S DATA2000=$G(@GLV@("Data2000WaiverID",0))
  1. .S MUTDEF=$G(@GLV@("MutuallyDefined",0))
  1. .S REMSID=$G(@GLV@("REMSHealthcareProviderEnrollmentID",0))
  1. .S STSUBNUM=$G(@GLV@("StateControlSubstanceNumber",0))
  1. .S FDA(FILE,IENS,318.1)=STATELIC,FDA(FILE,IENS,318.2)=MEDICARE,FDA(FILE,IENS,318.3)=MEDICAID
  1. .S FDA(FILE,IENS,319.1)=UPIN,FDA(FILE,IENS,319.2)=DEA,FDA(FILE,IENS,319.3)=HIN
  1. .S FDA(FILE,IENS,319.4)=SOCSEC,FDA(FILE,IENS,319.5)=NPI
  1. .S FDA(FILE,IENS,321.1)=CERTPRES,FDA(FILE,IENS,321.2)=DATA2000,FDA(FILE,IENS,321.3)=MUTDEF
  1. .S FDA(FILE,IENS,322.1)=REMSID,FDA(FILE,IENS,322.2)=STSUBNUM
  1. .D FILE^DIE(,"FDA") K FDA
  1. .D PRE^PSOERXIB(ERXIEN,MTYPE,"S",,CHRES) ;passing CHRES to PSOERXIB to file supervisor for change response
  1. .S GLE=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0))
  1. .S NOTE=$G(@GLE@("Note",0))
  1. .S DATE=$G(@GLE@("Date",0))
  1. .S SPECIALTY=$G(@GLE@("Specialty",0))
  1. .S FDA(FILE,IENS,324)=DATE
  1. .S FDA(FILE,IENS,325)=SPECIALTY
  1. .D CFDA^PSOERXIU(.FDA)
  1. .D FILE^DIE(,"FDA") K FDA
  1. Q