- 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 Jan 18, 2025@03:29:45 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