PSOERXIB ;ALB/BWF - eRx parsing Utilities ; 08 Jan 2020 4:23 PM
;;7.0;OUTPATIENT PHARMACY;**581,700**;DEC 1997;Build 261
;
Q
PRE(ERXIEN,MTYPE,PTYPE,PIEN,CHRES) ; prescriber
N GL,FN,LN,MN,SUFF,PREF,AL1,AL2,CITY,STATE,ZIP,IDDONE,I,IDNM,IDVAL,C,CQUAL,CVAL,SPEC,AFN,ALN,AMN,APREF,ASUFF,FULLNM
N EIENS,FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,IDFND,SRCH,PNPI,PDEA,GL2,FQUAL,FROM,SIEN,PNAME,PADD,GLPAN,GLPAFN,AFNAME
N AFLN,AFFN,AFMN,AFSUFF,AFPREF,PPOS,PLOCTYPE,PLOCVAL,PLOCBN,FLN,FFN,FMN,FSUFF,FPREF,PADD,ALN,AFN,AMN,ASUFF,APREF,SSN
N AFNAME,PLNCPDP,PLSTLIC,PLMCARE,PLMCAID,PLUPIN,PLFACID,PLDEA,PLHIN,PLNPI,PLMDEF,PLMREMS,PLOBCN,GLN,GLA,GLPAA,VNV,CTRY
N ANAME,CERT2RX,DATA2000,F,HIN,MDEF,MEDICAID,MEDICARE,PFNAME,PLREMS,PNODE,REMSID,STCSNUM,STLIC,UPIN
I PTYPE'="P" S PNODE=$S(PTYPE="PR":"Prescriber",PTYPE="S":"Supervisor",PTYPE="FP":"FollowUpPrescriber",1:"")
I PTYPE="P" S PNODE="Pharmacy",VNV="Pharmacist"
I PTYPE'="P" S VNV=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,""))
I PTYPE'="P",PNODE="" Q
I PTYPE'="P",'$D(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE)) Q
I PTYPE="P",'$D(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV)) Q
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0))
S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"Name",0))
S GLA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"Address",0))
S GL2=$NA(^TMP($J,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
S GLPAN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Name",0))
S GLPAFN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"FormerName",0))
;S GLPAA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Address",0))
I $G(CHRES) D
.S VNV=$O(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,""))
.S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0))
.S GLA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0,"Address",0))
.S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0,"Name",0))
.;S GLPAN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Name",0))
S FQUAL=$G(@GL2@("From","A","Qualifier"))
S FROM=$G(@GL@("From",0))
I FQUAL="D",FROM]"" S PNPI=FROM
S F=52.48
S EIENS=ERXIEN_","
; PRESCRIBER NAME
S PNAME=$$NAME^PSOERXIU(GLN)
S LN=$P(PNAME,U),FN=$P(PNAME,U,2),MN=$P(PNAME,U,3),SUFF=$P(PNAME,U,4),PREF=$P(PNAME,U,5)
S FULLNM=LN_","_FN_$S(MN]"":" "_MN,1:"")
; PRESCRIBER FORMER NAME
S PFNAME=$$NAME^PSOERXIU(GLN)
S FLN=$P(PNAME,U),FFN=$P(PNAME,U,2),FMN=$P(PNAME,U,3),FSUFF=$P(PNAME,U,4),FPREF=$P(PNAME,U,5)
; PRESCRIBER ADDRESS
S PADD=$$ADDRESS^PSOERXIU(GLA)
S AL1=$P(PADD,U),AL2=$P(PADD,U,2),CITY=$P(PADD,U,3),STATE=$P(PADD,U,4),ZIP=$P(PADD,U,5),CTRY=$P(PADD,U,6)
S SIEN=$$STRES^PSOERXA2(ZIP,STATE)
S SPEC=$G(@GL@("Specialty",0))
; PRESCRIBER AGENT NAME
S ANAME=$$NAME^PSOERXIU(GLPAN)
S ALN=$P(ANAME,U),AFN=$P(ANAME,U,2),AMN=$P(ANAME,U,3),ASUFF=$P(ANAME,U,4),APREF=$P(ANAME,U,5)
; PRESCRIBER AGENT FORMER NAME
S AFNAME=$$NAME^PSOERXIU(GLPAFN)
S AFLN=$P(AFNAME,U),AFFN=$P(AFNAME,U,2),AFMN=$P(AFNAME,U,3),AFSUFF=$P(AFNAME,U,4),AFPREF=$P(AFNAME,U,5)
; try to match the provider/supervisor. if no match, create a new entry for this provider
; if there is no NPI, grab it from the Identification multiple.
I '$G(PNPI) S PNPI=$G(@GL@("Identification",0,"NPI",0))
; identification
S PDEA=$G(@GL@("Identification",0,"DEANumber",0))
S STLIC=$G(@GL@("Identification",0,"StateLicenseNumber",0))
S MEDICARE=$G(@GL@("Identification",0,"MedicareNumber",0))
S MEDICAID=$G(@GL@("Identification",0,"MedicaidNumber",0))
S UPIN=$G(@GL@("Identification",0,"UPIN",0))
S HIN=$G(@GL@("Identification",0,"HIN",0))
S SSN=$G(@GL@("Identification",0,"SocialSecurity",0))
S CERT2RX=$G(@GL@("Identification",0,"CertificateToPrescribe",0))
S DATA2000=$G(@GL@("Identification",0,"Data2000WaiverID",0))
S MDEF=$G(@GL@("Identification",0,"MutuallyDefined",0))
S REMSID=$G(@GL@("Identification",0,"REMSHealthcareProviderEnrollmentID",0))
S STCSNUM=$G(@GL@("Identification",0,"StateControlSubstanceNumber",0))
; practice location
S PLNCPDP=$G(@GL@("PracticeLocation",0,"Identification",0,"NCPDPID",0))
S PLSTLIC=$G(@GL@("PracticeLocation",0,"Identification",0,"StateLicenseNumber",0))
S PLMCARE=$G(@GL@("PracticeLocation",0,"Identification",0,"MedicareNumber",0))
S PLMCAID=$G(@GL@("PracticeLocation",0,"Identification",0,"MedicaidNumber",0))
S PLUPIN=$G(@GL@("PracticeLocation",0,"Identification",0,"UPIN",0))
S PLFACID=$G(@GL@("PracticeLocation",0,"Identification",0,"FacilityID",0))
S PLDEA=$G(@GL@("PracticeLocation",0,"Identification",0,"DEANumber",0))
S PLHIN=$G(@GL@("PracticeLocation",0,"Identification",0,"HIN",0))
S PLNPI=$G(@GL@("PracticeLocation",0,"Identification",0,"NPI",0))
S PLMDEF=$G(@GL@("PracticeLocation",0,"Identification",0,"MutuallyDefined",0))
S PLREMS=$G(@GL@("PracticeLocation",0,"Identification",0,"REMSHealthcareSettingEnrollmentID",0))
S PLOCBN=$G(@GL@("PracticeLocation",0,"BusinessName",0))
; place of service
S PPOS=$G(@GL@("PrescriberPlaceOfService",0))
S PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$G(PNPI),PDEA) I PRVIEN S NEW=0
I 'PRVIEN S NEW=1,PRVIEN="+1"
S PRVIENS=PRVIEN_","
; VET/NON-VET
I VNV="Veterinarian" S FDA(F,PRVIENS,19.1)=1
; person name
S FDA(F,PRVIENS,.01)=FULLNM,FDA(F,PRVIENS,.02)=LN,FDA(F,PRVIENS,.03)=FN,FDA(F,PRVIENS,.04)=MN,FDA(F,PRVIENS,.05)=SUFF,FDA(F,PRVIENS,.06)=PREF
; place of service
S FDA(F,PRVIENS,2.3)=PPOS
; former name
S FDA(F,PRVIENS,2.4)=FLN,FDA(F,PRVIENS,2.5)=FFN,FDA(F,PRVIENS,2.6)=FMN,FDA(F,PRVIENS,2.7)=FSUFF,FDA(F,PRVIENS,2.8)=FPREF
; address
S FDA(F,PRVIENS,4.1)=AL1,FDA(F,PRVIENS,4.2)=AL2,FDA(F,PRVIENS,4.3)=CITY
S FDA(F,PRVIENS,4.4)=SIEN,FDA(F,PRVIENS,4.5)=ZIP,FDA(F,PRVIENS,2.2)=CTRY
; agent name
I PTYPE'="P" D
.S FDA(F,PRVIENS,5.1)=ALN,FDA(F,PRVIENS,5.2)=AFN,FDA(F,PRVIENS,5.3)=AMN,FDA(F,PRVIENS,5.4)=ASUFF,FDA(F,PRVIENS,5.5)=APREF
; agent former name
I PTYPE'="P" D
.S FDA(F,PRVIENS,7.1)=AFLN,FDA(F,PRVIENS,7.2)=AFFN,FDA(F,PRVIENS,7.3)=AFMN,FDA(F,PRVIENS,7.4)=AFSUFF,FDA(F,PRVIENS,7.5)=AFPREF
; practice location
S FDA(F,PRVIENS,8.1)=$G(PLOCTYPE),FDA(F,PRVIENS,8.2)=$G(PLOCVAL),FDA(F,PRVIENS,8.3)=PLOCBN
; specialty
S FDA(F,PRVIENS,1.2)=SPEC
; identification
S FDA(F,PRVIENS,14.1)=STLIC,FDA(F,PRVIENS,14.2)=MEDICARE,FDA(F,PRVIENS,14.3)=MEDICAID,FDA(F,PRVIENS,14.4)=UPIN,FDA(F,PRVIENS,14.5)=PDEA
S FDA(F,PRVIENS,14.6)=HIN,FDA(F,PRVIENS,14.7)=SSN,FDA(F,PRVIENS,15.1)=PNPI,FDA(F,PRVIENS,15.2)=CERT2RX,FDA(F,PRVIENS,15.3)=DATA2000
S FDA(F,PRVIENS,15.4)=MDEF,FDA(F,PRVIENS,15.5)=REMSID,FDA(F,PRVIENS,15.6)=STCSNUM
; dual file NPI and DEA to fire off C and D cross references
S FDA(F,PRVIENS,1.5)=PNPI,FDA(F,PRVIENS,1.6)=PDEA
; practice location identification/name
S FDA(F,PRVIENS,17.1)=PLNCPDP,FDA(F,PRVIENS,17.2)=PLSTLIC,FDA(F,PRVIENS,17.3)=PLMCARE,FDA(F,PRVIENS,17.4)=PLMCAID,FDA(F,PRVIENS,17.5)=PLUPIN
S FDA(F,PRVIENS,17.6)=PLFACID,FDA(F,PRVIENS,18.1)=PLDEA,FDA(F,PRVIENS,18.2)=PLHIN,FDA(F,PRVIENS,18.3)=PLNPI,FDA(F,PRVIENS,18.4)=PLMDEF
S FDA(F,PRVIENS,18.5)=PLREMS,FDA(F,PRVIENS,18.6)=PLOCBN
; person type (provider, pharmacist, supervisor, etc)
S FDA(F,PRVIENS,1.1)=PTYPE
I 'NEW D Q
.D FILE^DIE(,"FDA")
.;if this is not a new provider, clear the communication values before attempting to store them
.D KILL^PSOERXIA(52.48,PRVIENS,"11*") ;P700
.S ARRAY(52.48,PRVIENS,12)="@"
.D UPDATE^DIE(,"ARRAY") K ARRAY
.D COMM^PSOERXIU(GL,52.4811,PRVIEN,52.48,12)
.I PTYPE="PR" S FDA(52.49,EIENS,2.1)=PRVIEN D FILE^DIE(,"FDA") K FDA
.I PTYPE="S" S FDA(52.49,EIENS,2.6)=PRVIEN D FILE^DIE(,"FDA") K FDA
.;/JSG/ POS*7.0*581 - BEGIN CHANGE (Add link from 52.49,2.2 to 52.48)
.I PTYPE="P" S (FDA(52.47,PIEN_",",4),FDA(52.49,EIENS,2.2))=PRVIEN D FILE^DIE(,"FDA") K FDA
.;/JSG/ - END CHANGE
.I PTYPE="FP" S FDA(52.49,EIENS,307.1)=PRVIEN D FILE^DIE(,"FDA") K FDA
; NEW entries
D UPDATE^DIE(,"FDA","NEWIEN") K FDA
S NPIEN=$O(NEWIEN(0)),NPIEN=$G(NEWIEN(NPIEN))
; FILE COMMUNICATION VALUES
D COMM^PSOERXIU(GL,52.4811,NPIEN,52.48,12)
;S FDA(52.49,EIENS,2.1)=NPIEN D FILE^DIE(,"FDA") K FDA
I $G(CHRES) S FDA(52.49,EIENS,323)=NPIEN D FILE^DIE(,"FDA") K FDA,CHRES
I PTYPE="PR" S FDA(52.49,EIENS,2.1)=NPIEN D FILE^DIE(,"FDA") K FDA
I PTYPE="S",'$G(CHRES) S FDA(52.49,EIENS,2.6)=NPIEN D FILE^DIE(,"FDA") K FDA
;/JSG/ POS*7.0*581 - BEGIN CHANGE (Add link from 52.49,2.2 to 52.48)
I PTYPE="P" S (FDA(52.47,PIEN_",",4),FDA(52.49,EIENS,2.2))=NPIEN D FILE^DIE(,"FDA") K FDA
;/JSG/ - END CHANGE
I PTYPE="FP" S FDA(52.49,EIENS,307.1)=NPIEN D FILE^DIE(,"FDA") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXIB 8972 printed Sep 23, 2025@20:05:01 Page 2
PSOERXIB ;ALB/BWF - eRx parsing Utilities ; 08 Jan 2020 4:23 PM
+1 ;;7.0;OUTPATIENT PHARMACY;**581,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
PRE(ERXIEN,MTYPE,PTYPE,PIEN,CHRES) ; prescriber
+1 NEW GL,FN,LN,MN,SUFF,PREF,AL1,AL2,CITY,STATE,ZIP,IDDONE,I,IDNM,IDVAL,C,CQUAL,CVAL,SPEC,AFN,ALN,AMN,APREF,ASUFF,FULLNM
+2 NEW EIENS,FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,IDFND,SRCH,PNPI,PDEA,GL2,FQUAL,FROM,SIEN,PNAME,PADD,GLPAN,GLPAFN,AFNAME
+3 NEW AFLN,AFFN,AFMN,AFSUFF,AFPREF,PPOS,PLOCTYPE,PLOCVAL,PLOCBN,FLN,FFN,FMN,FSUFF,FPREF,PADD,ALN,AFN,AMN,ASUFF,APREF,SSN
+4 NEW AFNAME,PLNCPDP,PLSTLIC,PLMCARE,PLMCAID,PLUPIN,PLFACID,PLDEA,PLHIN,PLNPI,PLMDEF,PLMREMS,PLOBCN,GLN,GLA,GLPAA,VNV,CTRY
+5 NEW ANAME,CERT2RX,DATA2000,F,HIN,MDEF,MEDICAID,MEDICARE,PFNAME,PLREMS,PNODE,REMSID,STCSNUM,STLIC,UPIN
+6 IF PTYPE'="P"
SET PNODE=$SELECT(PTYPE="PR":"Prescriber",PTYPE="S":"Supervisor",PTYPE="FP":"FollowUpPrescriber",1:"")
+7 IF PTYPE="P"
SET PNODE="Pharmacy"
SET VNV="Pharmacist"
+8 IF PTYPE'="P"
SET VNV=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,""))
+9 IF PTYPE'="P"
IF PNODE=""
QUIT
+10 IF PTYPE'="P"
IF '$DATA(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE))
QUIT
+11 IF PTYPE="P"
IF '$DATA(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV))
QUIT
+12 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0))
+13 SET GLN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"Name",0))
+14 SET GLA=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"Address",0))
+15 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
+16 SET GLPAN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Name",0))
+17 SET GLPAFN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"FormerName",0))
+18 ;S GLPAA=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Address",0))
+19 IF $GET(CHRES)
Begin DoDot:1
+20 SET VNV=$ORDER(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,""))
+21 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0))
+22 SET GLA=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0,"Address",0))
+23 SET GLN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Response",0,"Validated",0,PNODE,0,VNV,0,"Name",0))
+24 ;S GLPAN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,PNODE,0,VNV,0,"PrescriberAgent",0,"Name",0))
End DoDot:1
+25 SET FQUAL=$GET(@GL2@("From","A","Qualifier"))
+26 SET FROM=$GET(@GL@("From",0))
+27 IF FQUAL="D"
IF FROM]""
SET PNPI=FROM
+28 SET F=52.48
+29 SET EIENS=ERXIEN_","
+30 ; PRESCRIBER NAME
+31 SET PNAME=$$NAME^PSOERXIU(GLN)
+32 SET LN=$PIECE(PNAME,U)
SET FN=$PIECE(PNAME,U,2)
SET MN=$PIECE(PNAME,U,3)
SET SUFF=$PIECE(PNAME,U,4)
SET PREF=$PIECE(PNAME,U,5)
+33 SET FULLNM=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
+34 ; PRESCRIBER FORMER NAME
+35 SET PFNAME=$$NAME^PSOERXIU(GLN)
+36 SET FLN=$PIECE(PNAME,U)
SET FFN=$PIECE(PNAME,U,2)
SET FMN=$PIECE(PNAME,U,3)
SET FSUFF=$PIECE(PNAME,U,4)
SET FPREF=$PIECE(PNAME,U,5)
+37 ; PRESCRIBER ADDRESS
+38 SET PADD=$$ADDRESS^PSOERXIU(GLA)
+39 SET AL1=$PIECE(PADD,U)
SET AL2=$PIECE(PADD,U,2)
SET CITY=$PIECE(PADD,U,3)
SET STATE=$PIECE(PADD,U,4)
SET ZIP=$PIECE(PADD,U,5)
SET CTRY=$PIECE(PADD,U,6)
+40 SET SIEN=$$STRES^PSOERXA2(ZIP,STATE)
+41 SET SPEC=$GET(@GL@("Specialty",0))
+42 ; PRESCRIBER AGENT NAME
+43 SET ANAME=$$NAME^PSOERXIU(GLPAN)
+44 SET ALN=$PIECE(ANAME,U)
SET AFN=$PIECE(ANAME,U,2)
SET AMN=$PIECE(ANAME,U,3)
SET ASUFF=$PIECE(ANAME,U,4)
SET APREF=$PIECE(ANAME,U,5)
+45 ; PRESCRIBER AGENT FORMER NAME
+46 SET AFNAME=$$NAME^PSOERXIU(GLPAFN)
+47 SET AFLN=$PIECE(AFNAME,U)
SET AFFN=$PIECE(AFNAME,U,2)
SET AFMN=$PIECE(AFNAME,U,3)
SET AFSUFF=$PIECE(AFNAME,U,4)
SET AFPREF=$PIECE(AFNAME,U,5)
+48 ; try to match the provider/supervisor. if no match, create a new entry for this provider
+49 ; if there is no NPI, grab it from the Identification multiple.
+50 IF '$GET(PNPI)
SET PNPI=$GET(@GL@("Identification",0,"NPI",0))
+51 ; identification
+52 SET PDEA=$GET(@GL@("Identification",0,"DEANumber",0))
+53 SET STLIC=$GET(@GL@("Identification",0,"StateLicenseNumber",0))
+54 SET MEDICARE=$GET(@GL@("Identification",0,"MedicareNumber",0))
+55 SET MEDICAID=$GET(@GL@("Identification",0,"MedicaidNumber",0))
+56 SET UPIN=$GET(@GL@("Identification",0,"UPIN",0))
+57 SET HIN=$GET(@GL@("Identification",0,"HIN",0))
+58 SET SSN=$GET(@GL@("Identification",0,"SocialSecurity",0))
+59 SET CERT2RX=$GET(@GL@("Identification",0,"CertificateToPrescribe",0))
+60 SET DATA2000=$GET(@GL@("Identification",0,"Data2000WaiverID",0))
+61 SET MDEF=$GET(@GL@("Identification",0,"MutuallyDefined",0))
+62 SET REMSID=$GET(@GL@("Identification",0,"REMSHealthcareProviderEnrollmentID",0))
+63 SET STCSNUM=$GET(@GL@("Identification",0,"StateControlSubstanceNumber",0))
+64 ; practice location
+65 SET PLNCPDP=$GET(@GL@("PracticeLocation",0,"Identification",0,"NCPDPID",0))
+66 SET PLSTLIC=$GET(@GL@("PracticeLocation",0,"Identification",0,"StateLicenseNumber",0))
+67 SET PLMCARE=$GET(@GL@("PracticeLocation",0,"Identification",0,"MedicareNumber",0))
+68 SET PLMCAID=$GET(@GL@("PracticeLocation",0,"Identification",0,"MedicaidNumber",0))
+69 SET PLUPIN=$GET(@GL@("PracticeLocation",0,"Identification",0,"UPIN",0))
+70 SET PLFACID=$GET(@GL@("PracticeLocation",0,"Identification",0,"FacilityID",0))
+71 SET PLDEA=$GET(@GL@("PracticeLocation",0,"Identification",0,"DEANumber",0))
+72 SET PLHIN=$GET(@GL@("PracticeLocation",0,"Identification",0,"HIN",0))
+73 SET PLNPI=$GET(@GL@("PracticeLocation",0,"Identification",0,"NPI",0))
+74 SET PLMDEF=$GET(@GL@("PracticeLocation",0,"Identification",0,"MutuallyDefined",0))
+75 SET PLREMS=$GET(@GL@("PracticeLocation",0,"Identification",0,"REMSHealthcareSettingEnrollmentID",0))
+76 SET PLOCBN=$GET(@GL@("PracticeLocation",0,"BusinessName",0))
+77 ; place of service
+78 SET PPOS=$GET(@GL@("PrescriberPlaceOfService",0))
+79 SET PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$GET(PNPI),PDEA)
IF PRVIEN
SET NEW=0
+80 IF 'PRVIEN
SET NEW=1
SET PRVIEN="+1"
+81 SET PRVIENS=PRVIEN_","
+82 ; VET/NON-VET
+83 IF VNV="Veterinarian"
SET FDA(F,PRVIENS,19.1)=1
+84 ; person name
+85 SET FDA(F,PRVIENS,.01)=FULLNM
SET FDA(F,PRVIENS,.02)=LN
SET FDA(F,PRVIENS,.03)=FN
SET FDA(F,PRVIENS,.04)=MN
SET FDA(F,PRVIENS,.05)=SUFF
SET FDA(F,PRVIENS,.06)=PREF
+86 ; place of service
+87 SET FDA(F,PRVIENS,2.3)=PPOS
+88 ; former name
+89 SET FDA(F,PRVIENS,2.4)=FLN
SET FDA(F,PRVIENS,2.5)=FFN
SET FDA(F,PRVIENS,2.6)=FMN
SET FDA(F,PRVIENS,2.7)=FSUFF
SET FDA(F,PRVIENS,2.8)=FPREF
+90 ; address
+91 SET FDA(F,PRVIENS,4.1)=AL1
SET FDA(F,PRVIENS,4.2)=AL2
SET FDA(F,PRVIENS,4.3)=CITY
+92 SET FDA(F,PRVIENS,4.4)=SIEN
SET FDA(F,PRVIENS,4.5)=ZIP
SET FDA(F,PRVIENS,2.2)=CTRY
+93 ; agent name
+94 IF PTYPE'="P"
Begin DoDot:1
+95 SET FDA(F,PRVIENS,5.1)=ALN
SET FDA(F,PRVIENS,5.2)=AFN
SET FDA(F,PRVIENS,5.3)=AMN
SET FDA(F,PRVIENS,5.4)=ASUFF
SET FDA(F,PRVIENS,5.5)=APREF
End DoDot:1
+96 ; agent former name
+97 IF PTYPE'="P"
Begin DoDot:1
+98 SET FDA(F,PRVIENS,7.1)=AFLN
SET FDA(F,PRVIENS,7.2)=AFFN
SET FDA(F,PRVIENS,7.3)=AFMN
SET FDA(F,PRVIENS,7.4)=AFSUFF
SET FDA(F,PRVIENS,7.5)=AFPREF
End DoDot:1
+99 ; practice location
+100 SET FDA(F,PRVIENS,8.1)=$GET(PLOCTYPE)
SET FDA(F,PRVIENS,8.2)=$GET(PLOCVAL)
SET FDA(F,PRVIENS,8.3)=PLOCBN
+101 ; specialty
+102 SET FDA(F,PRVIENS,1.2)=SPEC
+103 ; identification
+104 SET FDA(F,PRVIENS,14.1)=STLIC
SET FDA(F,PRVIENS,14.2)=MEDICARE
SET FDA(F,PRVIENS,14.3)=MEDICAID
SET FDA(F,PRVIENS,14.4)=UPIN
SET FDA(F,PRVIENS,14.5)=PDEA
+105 SET FDA(F,PRVIENS,14.6)=HIN
SET FDA(F,PRVIENS,14.7)=SSN
SET FDA(F,PRVIENS,15.1)=PNPI
SET FDA(F,PRVIENS,15.2)=CERT2RX
SET FDA(F,PRVIENS,15.3)=DATA2000
+106 SET FDA(F,PRVIENS,15.4)=MDEF
SET FDA(F,PRVIENS,15.5)=REMSID
SET FDA(F,PRVIENS,15.6)=STCSNUM
+107 ; dual file NPI and DEA to fire off C and D cross references
+108 SET FDA(F,PRVIENS,1.5)=PNPI
SET FDA(F,PRVIENS,1.6)=PDEA
+109 ; practice location identification/name
+110 SET FDA(F,PRVIENS,17.1)=PLNCPDP
SET FDA(F,PRVIENS,17.2)=PLSTLIC
SET FDA(F,PRVIENS,17.3)=PLMCARE
SET FDA(F,PRVIENS,17.4)=PLMCAID
SET FDA(F,PRVIENS,17.5)=PLUPIN
+111 SET FDA(F,PRVIENS,17.6)=PLFACID
SET FDA(F,PRVIENS,18.1)=PLDEA
SET FDA(F,PRVIENS,18.2)=PLHIN
SET FDA(F,PRVIENS,18.3)=PLNPI
SET FDA(F,PRVIENS,18.4)=PLMDEF
+112 SET FDA(F,PRVIENS,18.5)=PLREMS
SET FDA(F,PRVIENS,18.6)=PLOCBN
+113 ; person type (provider, pharmacist, supervisor, etc)
+114 SET FDA(F,PRVIENS,1.1)=PTYPE
+115 IF 'NEW
Begin DoDot:1
+116 DO FILE^DIE(,"FDA")
+117 ;if this is not a new provider, clear the communication values before attempting to store them
+118 ;P700
DO KILL^PSOERXIA(52.48,PRVIENS,"11*")
+119 SET ARRAY(52.48,PRVIENS,12)="@"
+120 DO UPDATE^DIE(,"ARRAY")
KILL ARRAY
+121 DO COMM^PSOERXIU(GL,52.4811,PRVIEN,52.48,12)
+122 IF PTYPE="PR"
SET FDA(52.49,EIENS,2.1)=PRVIEN
DO FILE^DIE(,"FDA")
KILL FDA
+123 IF PTYPE="S"
SET FDA(52.49,EIENS,2.6)=PRVIEN
DO FILE^DIE(,"FDA")
KILL FDA
+124 ;/JSG/ POS*7.0*581 - BEGIN CHANGE (Add link from 52.49,2.2 to 52.48)
+125 IF PTYPE="P"
SET (FDA(52.47,PIEN_",",4),FDA(52.49,EIENS,2.2))=PRVIEN
DO FILE^DIE(,"FDA")
KILL FDA
+126 ;/JSG/ - END CHANGE
+127 IF PTYPE="FP"
SET FDA(52.49,EIENS,307.1)=PRVIEN
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
QUIT
+128 ; NEW entries
+129 DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
+130 SET NPIEN=$ORDER(NEWIEN(0))
SET NPIEN=$GET(NEWIEN(NPIEN))
+131 ; FILE COMMUNICATION VALUES
+132 DO COMM^PSOERXIU(GL,52.4811,NPIEN,52.48,12)
+133 ;S FDA(52.49,EIENS,2.1)=NPIEN D FILE^DIE(,"FDA") K FDA
+134 IF $GET(CHRES)
SET FDA(52.49,EIENS,323)=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA,CHRES
+135 IF PTYPE="PR"
SET FDA(52.49,EIENS,2.1)=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA
+136 IF PTYPE="S"
IF '$GET(CHRES)
SET FDA(52.49,EIENS,2.6)=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA
+137 ;/JSG/ POS*7.0*581 - BEGIN CHANGE (Add link from 52.49,2.2 to 52.48)
+138 IF PTYPE="P"
SET (FDA(52.47,PIEN_",",4),FDA(52.49,EIENS,2.2))=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA
+139 ;/JSG/ - END CHANGE
+140 IF PTYPE="FP"
SET FDA(52.49,EIENS,307.1)=NPIEN
DO FILE^DIE(,"FDA")
KILL FDA
+141 QUIT
