PSOERXIC ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581,700**;DEC 1997;Build 261
;
Q
PHR(ERXIEN,MTYPE) ; pharamcy
N GL,GLN,GLFN,GLAD,SNAME,AL1,AL2,CIT,STATE,ZIP,PLQUAL,COMTYP,COMVAL,I,F,EIENS,PHIEN,CCNT,NEW,SPEC,FDA,NEWPHIEN,GL2,FQUAL,FROM,SIEN
N NCPDPID,STLICNUM,MCARENUM,MCAIDNUM,UPIN,HIN,NPI,MDEF,PHADD,PHFNAME,F2,GLADD,DEANUM,KPIEN,NIEN,NIENODE
N PHAL1,PHAL2,PHCTRY,PHCTY,PHST,PHZIP
S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0))
S GLADD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Address",0))
S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Name",0))
S GLFN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"FormerName",0))
S GLAD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Address",0))
S GL2=$NA(^TMP($J,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
S FQUAL=$G(@GL2@("From","A","Qualifier"))
S FROM=$G(@GL@("From",0))
I FQUAL="P",FROM]"" S NCPDPID=FROM
S F=52.47,PHIEN="",F2=52.48
S EIENS=ERXIEN_","
S SNAME=$G(@GL@("BusinessName",0))
Q:'$L(SNAME)
I $D(^PS(52.47,"B",SNAME)) S PHIEN=$O(^PS(52.47,"B",SNAME,0)) I PHIEN S PHIEN=PHIEN_",",NEW=0
I 'PHIEN S PHIEN="+1,",NEW=1
; Identification
S FDA(F,PHIEN,.01)=SNAME,FDA(F,PHIEN,.05)=SNAME
S NCPDPID=$G(@GL@("Identification",0,"NCPDPID",0)),FDA(F,PHIEN,10.1)=NCPDPID
S STLICNUM=$G(@GL@("Identification",0,"StateLicenseNumber",0)),FDA(F,PHIEN,9.1)=STLICNUM
S MCARENUM=$G(@GL@("Identification",0,"MedicareNumber",0)),FDA(F,PHIEN,9.2)=MCARENUM
S MCAIDNUM=$G(@GL@("Identification",0,"MedicaidNumber",0)),FDA(F,PHIEN,9.3)=MCAIDNUM
S UPIN=$G(@GL@("Identification",0,"UPIN",0)),FDA(F,PHIEN,9.4)=UPIN
S DEANUM=$G(@GL@("Identification",0,"DEANumber",0)),FDA(F,PHIEN,10.3)=DEANUM
;S FDA(F,PHIEN,.04)=DEANUM
S HIN=$G(@GL@("Identification",0,"HIN",0)),FDA(F,PHIEN,9.5)=HIN
S NPI=$G(@GL@("Identification",0,"NPI",0)),FDA(F,PHIEN,10.2)=NPI
S MDEF=$G(@GL@("Identification",0,"MutuallyDefined",0)),FDA(F,PHIEN,9.6)=MDEF
S SPEC=$G(@GL@("Specialty",0)),FDA(F,PHIEN,1.8)=SPEC
; pharmacy address
S PHADD=$$ADDRESS^PSOERXIU(GLADD)
S PHAL1=$P(PHADD,U),PHAL2=$P(PHADD,U,2),PHCTY=$P(PHADD,U,3),PHST=$P(PHADD,U,4),PHZIP=$P(PHADD,U,5),PHCTRY=$P(PHADD,U,6)
S PHST=$$STRES^PSOERXA2(PHZIP,PHST)
S FDA(F,PHIEN,1.1)=PHAL1,FDA(F,PHIEN,1.2)=PHAL2,FDA(F,PHIEN,1.3)=PHCTY,FDA(F,PHIEN,1.4)=PHST,FDA(F,PHIEN,1.5)=PHZIP,FDA(F,PHIEN,1.7)=PHCTRY
I 'NEW D Q
.D FILE^DIE(,"FDA") K FDA
.; pharmacy communication numbers - clear the old ones if this is an existing entry
.S KPIEN=$P(PHIEN,",")
.I KPIEN D ;P700
..D KILL^PSOERXIA(52.47,PHIEN,"7*")
..S ARRAY(52.47,PHIEN,8)="@"
..D UPDATE^DIE(,"ARRAY") K ARRAY
.D COMM^PSOERXIU(GL,52.477,KPIEN,52.47,8)
.; link the pharmacy to the eRx record
.S FDA(52.49,ERXIEN_",",2.5)=KPIEN D FILE^DIE(,"FDA")
.; end pharmacy communication numbers
.; ----------
.; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
.D PRE^PSOERXIB(ERXIEN,MTYPE,"P",KPIEN)
D UPDATE^DIE(,"FDA","NIEN") K FDA
S NIENODE=$O(NIEN(0)),NIEN=$G(NIEN(NIENODE))
; pharmacy communication numbers
D COMM^PSOERXIU(GL,52.477,NIEN,52.47,8)
; end pharmacy communication numbers
; ----------
; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
D PRE^PSOERXIB(ERXIEN,MTYPE,"P",PHIEN)
; link the pharmacy to the eRx record
S FDA(52.49,ERXIEN_",",2.5)=NIEN D FILE^DIE(,"FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXIC 3601 printed Sep 23, 2025@20:05:02 Page 2
PSOERXIC ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
PHR(ERXIEN,MTYPE) ; pharamcy
+1 NEW GL,GLN,GLFN,GLAD,SNAME,AL1,AL2,CIT,STATE,ZIP,PLQUAL,COMTYP,COMVAL,I,F,EIENS,PHIEN,CCNT,NEW,SPEC,FDA,NEWPHIEN,GL2,FQUAL,FROM,SIEN
+2 NEW NCPDPID,STLICNUM,MCARENUM,MCAIDNUM,UPIN,HIN,NPI,MDEF,PHADD,PHFNAME,F2,GLADD,DEANUM,KPIEN,NIEN,NIENODE
+3 NEW PHAL1,PHAL2,PHCTRY,PHCTY,PHST,PHZIP
+4 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0))
+5 SET GLADD=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Address",0))
+6 SET GLN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Name",0))
+7 SET GLFN=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"FormerName",0))
+8 SET GLAD=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Address",0))
+9 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
+10 SET FQUAL=$GET(@GL2@("From","A","Qualifier"))
+11 SET FROM=$GET(@GL@("From",0))
+12 IF FQUAL="P"
IF FROM]""
SET NCPDPID=FROM
+13 SET F=52.47
SET PHIEN=""
SET F2=52.48
+14 SET EIENS=ERXIEN_","
+15 SET SNAME=$GET(@GL@("BusinessName",0))
+16 if '$LENGTH(SNAME)
QUIT
+17 IF $DATA(^PS(52.47,"B",SNAME))
SET PHIEN=$ORDER(^PS(52.47,"B",SNAME,0))
IF PHIEN
SET PHIEN=PHIEN_","
SET NEW=0
+18 IF 'PHIEN
SET PHIEN="+1,"
SET NEW=1
+19 ; Identification
+20 SET FDA(F,PHIEN,.01)=SNAME
SET FDA(F,PHIEN,.05)=SNAME
+21 SET NCPDPID=$GET(@GL@("Identification",0,"NCPDPID",0))
SET FDA(F,PHIEN,10.1)=NCPDPID
+22 SET STLICNUM=$GET(@GL@("Identification",0,"StateLicenseNumber",0))
SET FDA(F,PHIEN,9.1)=STLICNUM
+23 SET MCARENUM=$GET(@GL@("Identification",0,"MedicareNumber",0))
SET FDA(F,PHIEN,9.2)=MCARENUM
+24 SET MCAIDNUM=$GET(@GL@("Identification",0,"MedicaidNumber",0))
SET FDA(F,PHIEN,9.3)=MCAIDNUM
+25 SET UPIN=$GET(@GL@("Identification",0,"UPIN",0))
SET FDA(F,PHIEN,9.4)=UPIN
+26 SET DEANUM=$GET(@GL@("Identification",0,"DEANumber",0))
SET FDA(F,PHIEN,10.3)=DEANUM
+27 ;S FDA(F,PHIEN,.04)=DEANUM
+28 SET HIN=$GET(@GL@("Identification",0,"HIN",0))
SET FDA(F,PHIEN,9.5)=HIN
+29 SET NPI=$GET(@GL@("Identification",0,"NPI",0))
SET FDA(F,PHIEN,10.2)=NPI
+30 SET MDEF=$GET(@GL@("Identification",0,"MutuallyDefined",0))
SET FDA(F,PHIEN,9.6)=MDEF
+31 SET SPEC=$GET(@GL@("Specialty",0))
SET FDA(F,PHIEN,1.8)=SPEC
+32 ; pharmacy address
+33 SET PHADD=$$ADDRESS^PSOERXIU(GLADD)
+34 SET PHAL1=$PIECE(PHADD,U)
SET PHAL2=$PIECE(PHADD,U,2)
SET PHCTY=$PIECE(PHADD,U,3)
SET PHST=$PIECE(PHADD,U,4)
SET PHZIP=$PIECE(PHADD,U,5)
SET PHCTRY=$PIECE(PHADD,U,6)
+35 SET PHST=$$STRES^PSOERXA2(PHZIP,PHST)
+36 SET FDA(F,PHIEN,1.1)=PHAL1
SET FDA(F,PHIEN,1.2)=PHAL2
SET FDA(F,PHIEN,1.3)=PHCTY
SET FDA(F,PHIEN,1.4)=PHST
SET FDA(F,PHIEN,1.5)=PHZIP
SET FDA(F,PHIEN,1.7)=PHCTRY
+37 IF 'NEW
Begin DoDot:1
+38 DO FILE^DIE(,"FDA")
KILL FDA
+39 ; pharmacy communication numbers - clear the old ones if this is an existing entry
+40 SET KPIEN=$PIECE(PHIEN,",")
+41 ;P700
IF KPIEN
Begin DoDot:2
+42 DO KILL^PSOERXIA(52.47,PHIEN,"7*")
+43 SET ARRAY(52.47,PHIEN,8)="@"
+44 DO UPDATE^DIE(,"ARRAY")
KILL ARRAY
End DoDot:2
+45 DO COMM^PSOERXIU(GL,52.477,KPIEN,52.47,8)
+46 ; link the pharmacy to the eRx record
+47 SET FDA(52.49,ERXIEN_",",2.5)=KPIEN
DO FILE^DIE(,"FDA")
+48 ; end pharmacy communication numbers
+49 ; ----------
+50 ; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
+51 DO PRE^PSOERXIB(ERXIEN,MTYPE,"P",KPIEN)
End DoDot:1
QUIT
+52 DO UPDATE^DIE(,"FDA","NIEN")
KILL FDA
+53 SET NIENODE=$ORDER(NIEN(0))
SET NIEN=$GET(NIEN(NIENODE))
+54 ; pharmacy communication numbers
+55 DO COMM^PSOERXIU(GL,52.477,NIEN,52.47,8)
+56 ; end pharmacy communication numbers
+57 ; ----------
+58 ; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
+59 DO PRE^PSOERXIB(ERXIEN,MTYPE,"P",PHIEN)
+60 ; link the pharmacy to the eRx record
+61 SET FDA(52.49,ERXIEN_",",2.5)=NIEN
DO FILE^DIE(,"FDA")
+62 QUIT
