- PSOERXIA ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
- ;;7.0;OUTPATIENT PHARMACY;**581,700,746**;DEC 1997;Build 106
- ;
- Q
- PAT(ERXIEN,MTYPE) ; patient
- N F,EIENS,GL,GLN,GLFN,GLALT,GLFALT,MEDICARE,MEDICAID,MRID,PATACC,PATSSN,MUTDEF,REMPATID,PATNAME,LN,FN,MN,SUFF,PREF,PFN,FPATNAME
- N FLN,FFN,FMN,FSUFF,FPREF,GEN,DOB,ADDINFO,AL1,LOCFAC,LOCBED,LOCROOM,LANGNC,ALTNM,ALTLN,ALTFN,ALTMN,ALTSUFF,ALTPREF,FALTNM,FALTLN
- N FALTFN,FALTMN,FALTSUFF,FALTPREF,ALTADD,ALTAL1,ALTAL2,ALTCITY,ALTSTATE,ALTPOST,ALTCC,ALTCONRE,GESTAGE,HOSPIND,SIEN,ERXPAT,PIENS
- N NPIEN,FDA,NEWPAT,SPEC,GLPADD,GLALTNM,GLALTADD,AL2,CC,CITY,GLALTAD,POSTAL,STATE
- S F=52.46
- S EIENS=ERXIEN_","
- S SPEC=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,""))
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0))
- S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Name",0))
- S GLFN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"FormerName",0))
- S GLALT=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0))
- S GLALTNM=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Name",0))
- S GLALTAD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Address",0))
- S GLFALT=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"FormerName",0))
- S GLPADD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Address",0))
- S MEDICARE=$G(@GL@("Identification",0,"MedicareNumber",0))
- S MEDICAID=$G(@GL@("Identification",0,"MedicaidNumber",0))
- S MRID=$G(@GL@("Identification",0,"MedicalRecordIdentificationNumberEHR",0))
- S PATACC=$G(@GL@("Identification",0,"PatientAccountNumber",0))
- S PATSSN=$G(@GL@("Identification",0,"SocialSecurity",0))
- S MUTDEF=$G(@GL@("Identification",0,"MutuallyDefined",0))
- S REMPATID=$G(@GL@("Identification",0,"REMSPatientID",0))
- S PATNAME=$$NAME^PSOERXIU(GLN)
- 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)
- S PFN=LN_","_FN_$S(MN]"":" "_MN,1:"")
- S FPATNAME=$$NAME^PSOERXIU(GLFN)
- 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)
- S GEN=$G(@GL@("Gender",0))
- S DOB=$G(@GL@("DateOfBirth",0,"Date",0))
- I '$L(DOB) S DOB=$G(@GL@("DateOfBirth",0,"DateTime",0))
- S DOB=$$CONVDTTM^PSOERXA1(DOB)
- I DOB<1 S DOB=""
- S ADDINFO=$$ADDRESS^PSOERXIU(GLPADD)
- 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)
- S STATE=$$STRES^PSOERXA2(POSTAL,STATE)
- S LOCFAC=$G(@GL@("PatientLocation",0,"FacilityUnit",0))
- S LOCBED=$G(@GL@("PatientLocation",0,"Bed",0))
- S LOCROOM=$G(@GL@("PatientLocation",0,"Room",0))
- S LANGNC=$G(@GL@("LanguageNameCode",0))
- S ALTNM=$$NAME^PSOERXIU(GLALTNM)
- 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)
- S FALTNM=$$NAME^PSOERXIU(GLFALT)
- 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)
- S ALTADD=$$ADDRESS^PSOERXIU(GLALTAD)
- 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)
- S ALTSTATE=$$STRES^PSOERXA2(ALTPOST,ALTSTATE)
- S ALTCONRE=$G(@GL@("AlternateContact",0,"AlternateContactRelationship",0)) ;***need field***
- S GESTAGE=$G(@GL@("GestationalAge",0))
- S HOSPIND=$G(@GL@("HospiceIndicator",0))
- ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
- ; check 52.46 for a match before filing
- S ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$G(PATSSN),$G(AL1)) S PIENS=$S(ERXPAT:ERXPAT_",",1:"+1,")
- ;patient name info
- 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
- ;patient date of birth, gender
- S FDA(F,PIENS,.07)=GEN,FDA(F,PIENS,.08)=DOB
- ;patient address info
- 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
- ;former name
- 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)
- ;patient location
- S FDA(F,PIENS,8.1)=$G(LOCFAC),FDA(F,PIENS,8.2)=$G(LOCROOM),FDA(F,PIENS,8.3)=$G(LOCBED)
- ;language name code, gestational age, hospice indicator
- S FDA(F,PIENS,8.4)=$G(LANGNC),FDA(F,PIENS,8.5)=$G(GESTAGE),FDA(F,PIENS,8.6)=$G(HOSPIND)
- ;alternate contact name
- 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)
- ;alternate contact relationship
- I $L(ALTCONRE) S FDA(F,PIENS,9.6)=$$PRESOLV^PSOERXA1($G(ALTCONRE),"ACR")
- ;alternate contact former name
- 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)
- ;alt contact address info
- 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)
- S FDA(F,PIENS,11.5)=$G(ALTPOST),FDA(F,PIENS,11.6)=$G(ALTCC)
- ;identification
- S FDA(F,PIENS,17.1)=$G(MEDICARE),FDA(F,PIENS,17.2)=$G(MEDICAID),FDA(F,PIENS,17.3)=MRID
- 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)
- ; dual file SSN into old field to trigger the SSN cross reference to be built.
- S FDA(F,PIENS,1.4)=$G(PATSSN)
- I PIENS["+" D Q
- .D CFDA^PSOERXIU(.FDA)
- .D UPDATE^DIE(,"FDA","NEWPAT") K FDA
- .S NPIEN=$O(NEWPAT(0)),NPIEN=$G(NEWPAT(NPIEN))
- .Q:'NPIEN
- .S NPIEN=NPIEN
- .D COMM^PSOERXIU(GL,52.4613,NPIEN,52.46,14) ;patient communication
- .N IENS S IENS=NPIEN_"," ;P700
- .D KILL(52.46,IENS,"15*")
- .S ARRAY(52.46,IENS,16)="@"
- .D UPDATE^DIE(,"ARRAY") K ARRAY
- .D COMM^PSOERXIU(GLALT,52.4615,NPIEN,52.46,16) ;alternate contact communication
- .D SUB(GL,NPIEN_",") ;patient substances
- .S FDA(52.49,EIENS,.04)=NPIEN D FILE^DIE(,"FDA") K FDA
- N IENS S IENS=ERXPAT_"," ;P700
- D KILL(52.46,IENS,"13*")
- S ARRAY(52.46,IENS,14)="@"
- D UPDATE^DIE(,"ARRAY") K ARRAY
- D CFDA^PSOERXIU(.FDA)
- D FILE^DIE(,"FDA") K FDA
- D COMM^PSOERXIU(GL,52.4613,ERXPAT,52.46,14)
- D COMM^PSOERXIU(GLALT,52.4615,ERXPAT,52.46,16)
- D SUB(GL,PIENS)
- S FDA(52.49,EIENS,.04)=ERXPAT D FILE^DIE(,"FDA") K FDA
- Q
- KILL(FILE,IENS,NODE) ;P700 creating tag to delete entries using FileMan
- D GETS^DIQ(FILE,IENS,NODE,,"ARRAY")
- S (ARFILE,ARIENS)=""
- F S ARFILE=$O(ARRAY(ARFILE)) Q:'ARFILE D
- . F S ARIENS=$O(ARRAY(ARFILE,ARIENS)) Q:'ARIENS D
- . . S ARRAY(ARFILE,ARIENS,.01)="@"
- D UPDATE^DIE(,"ARRAY") K ARRAY
- Q
- ;
- SUB(GL,IENS) ; parsing and filing into substance multiple ***should we replace or update??? TO DO - CLEAR OUT OR MATCH/UPDATE
- N SUBSEQ,SF,SUBTT,SUBTQ,SUBTC,SUBLT,SUBLQ,SUBLC,ROAT,ROAQ,ROAC,FDA,I,SIENS
- S SUBSEQ=0,SF=52.4619
- S I=-1 F S I=$O(@GL@("SubstanceUse",0,"Substance",I)) Q:I="" D
- .S SUBSEQ=$G(SUBSEQ)+1
- .S SUBTT=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Text",0))
- .S SUBTQ=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Qualifier",0))
- .S SUBTC=$G(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Code",0))
- .S SUBLT=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Text",0))
- .S SUBLQ=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Qualifier",0))
- .S SUBLC=$G(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Code",0))
- .S ROAT=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Text",0))
- .S ROAQ=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Qualifier",0))
- .S ROAC=$G(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Code",0))
- .S SIENS="+"_SUBSEQ_","_IENS
- .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)
- .S FDA(SF,SIENS,4)=$G(SUBLT),FDA(SF,SIENS,5)=$G(SUBLQ),FDA(SF,SIENS,6)=$G(SUBLC)
- .S FDA(SF,SIENS,7)=$G(ROAT),FDA(SF,SIENS,8)=$G(ROAQ),FDA(SF,SIENS,9)=$G(ROAC)
- D CFDA^PSOERXIU(.FDA)
- D UPDATE^DIE(,"FDA") K FDA
- Q
- CHMESREQ(ERXIEN,MTYPE) ; message request code(s) for change request
- N GL,MRCODE,RETREC,REQREFNM,URGIND,GLVAL,RESTYPE,MREQCODE,CHGL,SEQUENCE,FDA,I,GLV,GLVAL,CHRES,STATELIC,MEDICARE,MEDICAID,UPIN
- N DEA,HIM,SOCSEC,NPI,CERTPRES,DATA2000,MUTDEF,REMSID,STSUBNUM,NOTE,DATE,SPECIALTY,FILE,GLE,HIN,MRSC,RESTNODE,RESTUP,EXTRCODE,REATXT
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0))
- S (MREQCODE,EXTRCODE)=$G(@GL@(MTYPE,0,"MessageRequestCode",0))
- S MREQCODE=$$PRESOLV^PSOERXA1(MREQCODE,"MRC")
- S FDA(52.49,ERXIEN_",",315.1)=MREQCODE
- D FILE^DIE(,"FDA") K FDA
- S I=-1,F=52.49316,IENS=ERXIEN_",",SEQUENCE=0
- F S I=$O(@GL@(MTYPE,0,"MessageRequestSubCode",I)) Q:I="" D
- .S SEQUENCE=SEQUENCE+1
- .S MRSC=$G(@GL@(MTYPE,0,"MessageRequestSubCode",I))
- .S MRSC=$$PRESOLV^PSOERXA1(MRSC,$S(EXTRCODE="U":"MRSC",1:"REA"))
- .S FDA(F,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE
- .S FDA(F,"+"_SEQUENCE_","_IENS,1)=MRSC
- D UPDATE^DIE(,"FDA") K FDA
- S REATXT(1,0)=$G(@GL@(MTYPE,0,"ChangeReasonText",0))
- I $G(REATXT(1,0))'="" D
- . S FDA(52.49,ERXIEN_",",317)="REATXT"
- . D UPDATE^DIE("","FDA")
- I MTYPE="RxChangeRequest" Q
- S GLVAL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0))
- S RESTYPE=$O(@GLVAL@("")),RESTUP=$$UP^XLFSTR(RESTYPE),RESTUP=$TR(RESTUP," ",""),RESTUP=$TR(RESTUP,",","")
- S RESTNODE=RESTYPE
- S RESTYPE=$S(RESTUP="VALIDATED":"V","APPROVED":"A",RESTUP="DENIED":"D",RESTUP="APPROVEDWITHCHANGES":"AWC",1:"")
- ; ADD SECOND CHECK FOR DATA
- I RESTYPE="V" D
- .S CHRES=1
- .S FILE=52.49
- .S GLV=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,"Identification",0))
- .S STATELIC=$G(@GLV@("StateLicenseNumber",0))
- .S MEDICARE=$G(@GLV@("MedicareNumber",0))
- .S MEDICAID=$G(@GLV@("MedicaidNumber",0))
- .S UPIN=$G(@GLV@("UPIN",0))
- .S DEA=$G(@GLV@("DEANumber",0))
- .S HIN=$G(@GLV@("HIN",0))
- .S SOCSEC=$G(@GLV@("SocialSecurity",0))
- .S NPI=$G(@GLV@("NPI",0))
- .S CERTPRES=$G(@GLV@("CertificateToPrescribe",0))
- .S DATA2000=$G(@GLV@("Data2000WaiverID",0))
- .S MUTDEF=$G(@GLV@("MutuallyDefined",0))
- .S REMSID=$G(@GLV@("REMSHealthcareProviderEnrollmentID",0))
- .S STSUBNUM=$G(@GLV@("StateControlSubstanceNumber",0))
- .S FDA(FILE,IENS,318.1)=STATELIC,FDA(FILE,IENS,318.2)=MEDICARE,FDA(FILE,IENS,318.3)=MEDICAID
- .S FDA(FILE,IENS,319.1)=UPIN,FDA(FILE,IENS,319.2)=DEA,FDA(FILE,IENS,319.3)=HIN
- .S FDA(FILE,IENS,319.4)=SOCSEC,FDA(FILE,IENS,319.5)=NPI
- .S FDA(FILE,IENS,321.1)=CERTPRES,FDA(FILE,IENS,321.2)=DATA2000,FDA(FILE,IENS,321.3)=MUTDEF
- .S FDA(FILE,IENS,322.1)=REMSID,FDA(FILE,IENS,322.2)=STSUBNUM
- .D FILE^DIE(,"FDA") K FDA
- .D PRE^PSOERXIB(ERXIEN,MTYPE,"S",,CHRES) ;passing CHRES to PSOERXIB to file supervisor for change response
- .S GLE=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0))
- .S NOTE=$G(@GLE@("Note",0))
- .S DATE=$G(@GLE@("Date",0))
- .S SPECIALTY=$G(@GLE@("Specialty",0))
- .S FDA(FILE,IENS,324)=DATE
- .S FDA(FILE,IENS,325)=SPECIALTY
- .D CFDA^PSOERXIU(.FDA)
- .D FILE^DIE(,"FDA") K FDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXIA 11302 printed Jan 18, 2025@03:29:44 Page 2
- PSOERXIA ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**581,700,746**;DEC 1997;Build 106
- +2 ;
- +3 QUIT
- PAT(ERXIEN,MTYPE) ; patient
- +1 NEW F,EIENS,GL,GLN,GLFN,GLALT,GLFALT,MEDICARE,MEDICAID,MRID,PATACC,PATSSN,MUTDEF,REMPATID,PATNAME,LN,FN,MN,SUFF,PREF,PFN,FPATNAME
- +2 NEW FLN,FFN,FMN,FSUFF,FPREF,GEN,DOB,ADDINFO,AL1,LOCFAC,LOCBED,LOCROOM,LANGNC,ALTNM,ALTLN,ALTFN,ALTMN,ALTSUFF,ALTPREF,FALTNM,FALTLN
- +3 NEW FALTFN,FALTMN,FALTSUFF,FALTPREF,ALTADD,ALTAL1,ALTAL2,ALTCITY,ALTSTATE,ALTPOST,ALTCC,ALTCONRE,GESTAGE,HOSPIND,SIEN,ERXPAT,PIENS
- +4 NEW NPIEN,FDA,NEWPAT,SPEC,GLPADD,GLALTNM,GLALTADD,AL2,CC,CITY,GLALTAD,POSTAL,STATE
- +5 SET F=52.46
- +6 SET EIENS=ERXIEN_","
- +7 SET SPEC=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,""))
- +8 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0))
- +9 SET GLN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Name",0))
- +10 SET GLFN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"FormerName",0))
- +11 SET GLALT=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0))
- +12 SET GLALTNM=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Name",0))
- +13 SET GLALTAD=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"Address",0))
- +14 SET GLFALT=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"AlternateContact",0,"FormerName",0))
- +15 SET GLPADD=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Patient",0,SPEC,0,"Address",0))
- +16 SET MEDICARE=$GET(@GL@("Identification",0,"MedicareNumber",0))
- +17 SET MEDICAID=$GET(@GL@("Identification",0,"MedicaidNumber",0))
- +18 SET MRID=$GET(@GL@("Identification",0,"MedicalRecordIdentificationNumberEHR",0))
- +19 SET PATACC=$GET(@GL@("Identification",0,"PatientAccountNumber",0))
- +20 SET PATSSN=$GET(@GL@("Identification",0,"SocialSecurity",0))
- +21 SET MUTDEF=$GET(@GL@("Identification",0,"MutuallyDefined",0))
- +22 SET REMPATID=$GET(@GL@("Identification",0,"REMSPatientID",0))
- +23 SET PATNAME=$$NAME^PSOERXIU(GLN)
- +24 SET LN=$PIECE(PATNAME,U,1)
- SET FN=$PIECE(PATNAME,U,2)
- SET MN=$PIECE(PATNAME,U,3)
- SET SUFF=$PIECE(PATNAME,U,4)
- SET PREF=$PIECE(PATNAME,U,5)
- +25 SET PFN=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
- +26 SET FPATNAME=$$NAME^PSOERXIU(GLFN)
- +27 SET FLN=$PIECE(FPATNAME,U,1)
- SET FFN=$PIECE(FPATNAME,U,2)
- SET FMN=$PIECE(FPATNAME,U,3)
- SET FSUFF=$PIECE(FPATNAME,U,4)
- SET FPREF=$PIECE(FPATNAME,U,5)
- +28 SET GEN=$GET(@GL@("Gender",0))
- +29 SET DOB=$GET(@GL@("DateOfBirth",0,"Date",0))
- +30 IF '$LENGTH(DOB)
- SET DOB=$GET(@GL@("DateOfBirth",0,"DateTime",0))
- +31 SET DOB=$$CONVDTTM^PSOERXA1(DOB)
- +32 IF DOB<1
- SET DOB=""
- +33 SET ADDINFO=$$ADDRESS^PSOERXIU(GLPADD)
- +34 SET AL1=$PIECE(ADDINFO,U,1)
- SET AL2=$PIECE(ADDINFO,U,2)
- SET CITY=$PIECE(ADDINFO,U,3)
- SET POSTAL=$PIECE(ADDINFO,U,5)
- SET STATE=$PIECE(ADDINFO,U,4)
- SET CC=$PIECE(ADDINFO,U,6)
- +35 SET STATE=$$STRES^PSOERXA2(POSTAL,STATE)
- +36 SET LOCFAC=$GET(@GL@("PatientLocation",0,"FacilityUnit",0))
- +37 SET LOCBED=$GET(@GL@("PatientLocation",0,"Bed",0))
- +38 SET LOCROOM=$GET(@GL@("PatientLocation",0,"Room",0))
- +39 SET LANGNC=$GET(@GL@("LanguageNameCode",0))
- +40 SET ALTNM=$$NAME^PSOERXIU(GLALTNM)
- +41 SET ALTLN=$PIECE(ALTNM,U,1)
- SET ALTFN=$PIECE(ALTNM,U,2)
- SET ALTMN=$PIECE(ALTNM,U,3)
- SET ALTSUFF=$PIECE(ALTNM,U,4)
- SET ALTPREF=$PIECE(ALTNM,U,5)
- +42 SET FALTNM=$$NAME^PSOERXIU(GLFALT)
- +43 SET FALTLN=$PIECE(FALTNM,U,1)
- SET FALTFN=$PIECE(FALTNM,U,2)
- SET FALTMN=$PIECE(FALTNM,U,3)
- SET FALTSUFF=$PIECE(ALTNM,U,4)
- SET FALTPREF=$PIECE(FALTNM,U,5)
- +44 SET ALTADD=$$ADDRESS^PSOERXIU(GLALTAD)
- +45 SET ALTAL1=$PIECE(ALTADD,U,1)
- SET ALTAL2=$PIECE(ALTADD,U,2)
- SET ALTCITY=$PIECE(ALTADD,U,3)
- SET ALTPOST=$PIECE(ALTADD,U,5)
- SET ALTSTATE=$PIECE(ALTADD,U,4)
- SET ALTCC=$PIECE(ALTADD,U,6)
- +46 SET ALTSTATE=$$STRES^PSOERXA2(ALTPOST,ALTSTATE)
- +47 ;***need field***
- SET ALTCONRE=$GET(@GL@("AlternateContact",0,"AlternateContactRelationship",0))
- +48 SET GESTAGE=$GET(@GL@("GestationalAge",0))
- +49 SET HOSPIND=$GET(@GL@("HospiceIndicator",0))
- +50 ; need to check for SSN before trying to match the patient. This needs to be stored in an array for later processing
- +51 ; check 52.46 for a match before filing
- +52 SET ERXPAT=$$FINDPAT^PSOERXU2(PFN,DOB,GEN,$GET(PATSSN),$GET(AL1))
- SET PIENS=$SELECT(ERXPAT:ERXPAT_",",1:"+1,")
- +53 ;patient name info
- +54 SET FDA(F,PIENS,.01)=PFN
- SET FDA(F,PIENS,.02)=LN
- SET FDA(F,PIENS,.03)=FN
- SET FDA(F,PIENS,.04)=MN
- SET FDA(F,PIENS,.05)=SUFF
- SET FDA(F,PIENS,.06)=PREF
- +55 ;patient date of birth, gender
- +56 SET FDA(F,PIENS,.07)=GEN
- SET FDA(F,PIENS,.08)=DOB
- +57 ;patient address info
- +58 SET FDA(F,PIENS,3.1)=AL1
- SET FDA(F,PIENS,3.2)=AL2
- SET FDA(F,PIENS,3.3)=CITY
- SET FDA(F,PIENS,3.4)=STATE
- SET FDA(F,PIENS,3.5)=POSTAL
- SET FDA(F,PIENS,1.6)=CC
- +59 ;former name
- +60 SET FDA(F,PIENS,7.1)=$GET(FLN)
- SET FDA(F,PIENS,7.2)=$GET(FFN)
- SET FDA(F,PIENS,7.3)=$GET(FMN)
- SET FDA(F,PIENS,7.4)=$GET(FSUFF)
- SET FDA(F,PIENS,7.5)=$GET(FPREF)
- +61 ;patient location
- +62 SET FDA(F,PIENS,8.1)=$GET(LOCFAC)
- SET FDA(F,PIENS,8.2)=$GET(LOCROOM)
- SET FDA(F,PIENS,8.3)=$GET(LOCBED)
- +63 ;language name code, gestational age, hospice indicator
- +64 SET FDA(F,PIENS,8.4)=$GET(LANGNC)
- SET FDA(F,PIENS,8.5)=$GET(GESTAGE)
- SET FDA(F,PIENS,8.6)=$GET(HOSPIND)
- +65 ;alternate contact name
- +66 SET FDA(F,PIENS,9.1)=$GET(ALTLN)
- SET FDA(F,PIENS,9.2)=$GET(ALTFN)
- SET FDA(F,PIENS,9.3)=$GET(ALTMN)
- SET FDA(F,PIENS,9.4)=$GET(ALTSUFF)
- SET FDA(F,PIENS,9.5)=$GET(ALTPREF)
- +67 ;alternate contact relationship
- +68 IF $LENGTH(ALTCONRE)
- SET FDA(F,PIENS,9.6)=$$PRESOLV^PSOERXA1($GET(ALTCONRE),"ACR")
- +69 ;alternate contact former name
- +70 SET FDA(F,PIENS,10.1)=$GET(FALTLN)
- SET FDA(F,PIENS,10.2)=$GET(FALTFN)
- SET FDA(F,PIENS,10.3)=$GET(FALTMN)
- SET FDA(F,PIENS,10.4)=$GET(FALTSUFF)
- SET FDA(F,PIENS,10.5)=$GET(FALTPREF)
- +71 ;alt contact address info
- +72 SET FDA(F,PIENS,11.1)=$GET(ALTAL1)
- SET FDA(F,PIENS,11.2)=$GET(ALTAL2)
- SET FDA(F,PIENS,11.3)=$GET(ALTCITY)
- SET FDA(F,PIENS,11.4)=$GET(ALTSTATE)
- +73 SET FDA(F,PIENS,11.5)=$GET(ALTPOST)
- SET FDA(F,PIENS,11.6)=$GET(ALTCC)
- +74 ;identification
- +75 SET FDA(F,PIENS,17.1)=$GET(MEDICARE)
- SET FDA(F,PIENS,17.2)=$GET(MEDICAID)
- SET FDA(F,PIENS,17.3)=MRID
- +76 SET FDA(F,PIENS,18.1)=$GET(PATACC)
- SET FDA(F,PIENS,18.2)=$GET(PATSSN)
- SET FDA(F,PIENS,18.3)=$GET(MUTDEF)
- SET FDA(F,PIENS,18.4)=$GET(REMPATID)
- +77 ; dual file SSN into old field to trigger the SSN cross reference to be built.
- +78 SET FDA(F,PIENS,1.4)=$GET(PATSSN)
- +79 IF PIENS["+"
- Begin DoDot:1
- +80 DO CFDA^PSOERXIU(.FDA)
- +81 DO UPDATE^DIE(,"FDA","NEWPAT")
- KILL FDA
- +82 SET NPIEN=$ORDER(NEWPAT(0))
- SET NPIEN=$GET(NEWPAT(NPIEN))
- +83 if 'NPIEN
- QUIT
- +84 SET NPIEN=NPIEN
- +85 ;patient communication
- DO COMM^PSOERXIU(GL,52.4613,NPIEN,52.46,14)
- +86 ;P700
- NEW IENS
- SET IENS=NPIEN_","
- +87 DO KILL(52.46,IENS,"15*")
- +88 SET ARRAY(52.46,IENS,16)="@"
- +89 DO UPDATE^DIE(,"ARRAY")
- KILL ARRAY
- +90 ;alternate contact communication
- DO COMM^PSOERXIU(GLALT,52.4615,NPIEN,52.46,16)
- +91 ;patient substances
- DO SUB(GL,NPIEN_",")
- +92 SET FDA(52.49,EIENS,.04)=NPIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT
- +93 ;P700
- NEW IENS
- SET IENS=ERXPAT_","
- +94 DO KILL(52.46,IENS,"13*")
- +95 SET ARRAY(52.46,IENS,14)="@"
- +96 DO UPDATE^DIE(,"ARRAY")
- KILL ARRAY
- +97 DO CFDA^PSOERXIU(.FDA)
- +98 DO FILE^DIE(,"FDA")
- KILL FDA
- +99 DO COMM^PSOERXIU(GL,52.4613,ERXPAT,52.46,14)
- +100 DO COMM^PSOERXIU(GLALT,52.4615,ERXPAT,52.46,16)
- +101 DO SUB(GL,PIENS)
- +102 SET FDA(52.49,EIENS,.04)=ERXPAT
- DO FILE^DIE(,"FDA")
- KILL FDA
- +103 QUIT
- KILL(FILE,IENS,NODE) ;P700 creating tag to delete entries using FileMan
- +1 DO GETS^DIQ(FILE,IENS,NODE,,"ARRAY")
- +2 SET (ARFILE,ARIENS)=""
- +3 FOR
- SET ARFILE=$ORDER(ARRAY(ARFILE))
- if 'ARFILE
- QUIT
- Begin DoDot:1
- +4 FOR
- SET ARIENS=$ORDER(ARRAY(ARFILE,ARIENS))
- if 'ARIENS
- QUIT
- Begin DoDot:2
- +5 SET ARRAY(ARFILE,ARIENS,.01)="@"
- End DoDot:2
- End DoDot:1
- +6 DO UPDATE^DIE(,"ARRAY")
- KILL ARRAY
- +7 QUIT
- +8 ;
- SUB(GL,IENS) ; parsing and filing into substance multiple ***should we replace or update??? TO DO - CLEAR OUT OR MATCH/UPDATE
- +1 NEW SUBSEQ,SF,SUBTT,SUBTQ,SUBTC,SUBLT,SUBLQ,SUBLC,ROAT,ROAQ,ROAC,FDA,I,SIENS
- +2 SET SUBSEQ=0
- SET SF=52.4619
- +3 SET I=-1
- FOR
- SET I=$ORDER(@GL@("SubstanceUse",0,"Substance",I))
- if I=""
- QUIT
- Begin DoDot:1
- +4 SET SUBSEQ=$GET(SUBSEQ)+1
- +5 SET SUBTT=$GET(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Text",0))
- +6 SET SUBTQ=$GET(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Qualifier",0))
- +7 SET SUBTC=$GET(@GL@("SubstanceUse",0,"Substance",I,"Type",0,"Code",0))
- +8 SET SUBLT=$GET(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Text",0))
- +9 SET SUBLQ=$GET(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Qualifier",0))
- +10 SET SUBLC=$GET(@GL@("SubstanceUse",0,"Substance",I,"Level",0,"Code",0))
- +11 SET ROAT=$GET(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Text",0))
- +12 SET ROAQ=$GET(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Qualifier",0))
- +13 SET ROAC=$GET(@GL@("SubstanceUse",0,"Substance",I,"RouteOfAdministration",0,"Code",0))
- +14 SET SIENS="+"_SUBSEQ_","_IENS
- +15 SET FDA(SF,SIENS,.01)=$GET(SUBSEQ)
- SET FDA(SF,SIENS,1)=$GET(SUBTT)
- SET FDA(SF,SIENS,2)=$GET(SUBTQ)
- SET FDA(SF,SIENS,3)=$GET(SUBTC)
- +16 SET FDA(SF,SIENS,4)=$GET(SUBLT)
- SET FDA(SF,SIENS,5)=$GET(SUBLQ)
- SET FDA(SF,SIENS,6)=$GET(SUBLC)
- +17 SET FDA(SF,SIENS,7)=$GET(ROAT)
- SET FDA(SF,SIENS,8)=$GET(ROAQ)
- SET FDA(SF,SIENS,9)=$GET(ROAC)
- End DoDot:1
- +18 DO CFDA^PSOERXIU(.FDA)
- +19 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +20 QUIT
- CHMESREQ(ERXIEN,MTYPE) ; message request code(s) for change request
- +1 NEW GL,MRCODE,RETREC,REQREFNM,URGIND,GLVAL,RESTYPE,MREQCODE,CHGL,SEQUENCE,FDA,I,GLV,GLVAL,CHRES,STATELIC,MEDICARE,MEDICAID,UPIN
- +2 NEW DEA,HIM,SOCSEC,NPI,CERTPRES,DATA2000,MUTDEF,REMSID,STSUBNUM,NOTE,DATE,SPECIALTY,FILE,GLE,HIN,MRSC,RESTNODE,RESTUP,EXTRCODE,REATXT
- +3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0))
- +4 SET (MREQCODE,EXTRCODE)=$GET(@GL@(MTYPE,0,"MessageRequestCode",0))
- +5 SET MREQCODE=$$PRESOLV^PSOERXA1(MREQCODE,"MRC")
- +6 SET FDA(52.49,ERXIEN_",",315.1)=MREQCODE
- +7 DO FILE^DIE(,"FDA")
- KILL FDA
- +8 SET I=-1
- SET F=52.49316
- SET IENS=ERXIEN_","
- SET SEQUENCE=0
- +9 FOR
- SET I=$ORDER(@GL@(MTYPE,0,"MessageRequestSubCode",I))
- if I=""
- QUIT
- Begin DoDot:1
- +10 SET SEQUENCE=SEQUENCE+1
- +11 SET MRSC=$GET(@GL@(MTYPE,0,"MessageRequestSubCode",I))
- +12 SET MRSC=$$PRESOLV^PSOERXA1(MRSC,$SELECT(EXTRCODE="U":"MRSC",1:"REA"))
- +13 SET FDA(F,"+"_SEQUENCE_","_IENS,.01)=SEQUENCE
- +14 SET FDA(F,"+"_SEQUENCE_","_IENS,1)=MRSC
- End DoDot:1
- +15 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +16 SET REATXT(1,0)=$GET(@GL@(MTYPE,0,"ChangeReasonText",0))
- +17 IF $GET(REATXT(1,0))'=""
- Begin DoDot:1
- +18 SET FDA(52.49,ERXIEN_",",317)="REATXT"
- +19 DO UPDATE^DIE("","FDA")
- End DoDot:1
- +20 IF MTYPE="RxChangeRequest"
- QUIT
- +21 SET GLVAL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0))
- +22 SET RESTYPE=$ORDER(@GLVAL@(""))
- SET RESTUP=$$UP^XLFSTR(RESTYPE)
- SET RESTUP=$TRANSLATE(RESTUP," ","")
- SET RESTUP=$TRANSLATE(RESTUP,",","")
- +23 SET RESTNODE=RESTYPE
- +24 SET RESTYPE=$SELECT(RESTUP="VALIDATED":"V","APPROVED":"A",RESTUP="DENIED":"D",RESTUP="APPROVEDWITHCHANGES":"AWC",1:"")
- +25 ; ADD SECOND CHECK FOR DATA
- +26 IF RESTYPE="V"
- Begin DoDot:1
- +27 SET CHRES=1
- +28 SET FILE=52.49
- +29 SET GLV=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,"Identification",0))
- +30 SET STATELIC=$GET(@GLV@("StateLicenseNumber",0))
- +31 SET MEDICARE=$GET(@GLV@("MedicareNumber",0))
- +32 SET MEDICAID=$GET(@GLV@("MedicaidNumber",0))
- +33 SET UPIN=$GET(@GLV@("UPIN",0))
- +34 SET DEA=$GET(@GLV@("DEANumber",0))
- +35 SET HIN=$GET(@GLV@("HIN",0))
- +36 SET SOCSEC=$GET(@GLV@("SocialSecurity",0))
- +37 SET NPI=$GET(@GLV@("NPI",0))
- +38 SET CERTPRES=$GET(@GLV@("CertificateToPrescribe",0))
- +39 SET DATA2000=$GET(@GLV@("Data2000WaiverID",0))
- +40 SET MUTDEF=$GET(@GLV@("MutuallyDefined",0))
- +41 SET REMSID=$GET(@GLV@("REMSHealthcareProviderEnrollmentID",0))
- +42 SET STSUBNUM=$GET(@GLV@("StateControlSubstanceNumber",0))
- +43 SET FDA(FILE,IENS,318.1)=STATELIC
- SET FDA(FILE,IENS,318.2)=MEDICARE
- SET FDA(FILE,IENS,318.3)=MEDICAID
- +44 SET FDA(FILE,IENS,319.1)=UPIN
- SET FDA(FILE,IENS,319.2)=DEA
- SET FDA(FILE,IENS,319.3)=HIN
- +45 SET FDA(FILE,IENS,319.4)=SOCSEC
- SET FDA(FILE,IENS,319.5)=NPI
- +46 SET FDA(FILE,IENS,321.1)=CERTPRES
- SET FDA(FILE,IENS,321.2)=DATA2000
- SET FDA(FILE,IENS,321.3)=MUTDEF
- +47 SET FDA(FILE,IENS,322.1)=REMSID
- SET FDA(FILE,IENS,322.2)=STSUBNUM
- +48 DO FILE^DIE(,"FDA")
- KILL FDA
- +49 ;passing CHRES to PSOERXIB to file supervisor for change response
- DO PRE^PSOERXIB(ERXIEN,MTYPE,"S",,CHRES)
- +50 SET GLE=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0))
- +51 SET NOTE=$GET(@GLE@("Note",0))
- +52 SET DATE=$GET(@GLE@("Date",0))
- +53 SET SPECIALTY=$GET(@GLE@("Specialty",0))
- +54 SET FDA(FILE,IENS,324)=DATE
- +55 SET FDA(FILE,IENS,325)=SPECIALTY
- +56 DO CFDA^PSOERXIU(.FDA)
- +57 DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +58 QUIT