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 Oct 16, 2024@18:29:14 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
