- 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 Feb 18, 2025@23:55:04 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