Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERXIC

PSOERXIC.m

Go to the documentation of this file.
  1. PSOERXIC ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,700**;DEC 1997;Build 261
  1. ;
  1. Q
  1. PHR(ERXIEN,MTYPE) ; pharamcy
  1. 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
  1. N NCPDPID,STLICNUM,MCARENUM,MCAIDNUM,UPIN,HIN,NPI,MDEF,PHADD,PHFNAME,F2,GLADD,DEANUM,KPIEN,NIEN,NIENODE
  1. N PHAL1,PHAL2,PHCTRY,PHCTY,PHST,PHZIP
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0))
  1. S GLADD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Address",0))
  1. S GLN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Name",0))
  1. S GLFN=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"FormerName",0))
  1. S GLAD=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0,"Pharmacist",0,"Address",0))
  1. S GL2=$NA(^TMP($J,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
  1. S FQUAL=$G(@GL2@("From","A","Qualifier"))
  1. S FROM=$G(@GL@("From",0))
  1. I FQUAL="P",FROM]"" S NCPDPID=FROM
  1. S F=52.47,PHIEN="",F2=52.48
  1. S EIENS=ERXIEN_","
  1. S SNAME=$G(@GL@("BusinessName",0))
  1. Q:'$L(SNAME)
  1. I $D(^PS(52.47,"B",SNAME)) S PHIEN=$O(^PS(52.47,"B",SNAME,0)) I PHIEN S PHIEN=PHIEN_",",NEW=0
  1. I 'PHIEN S PHIEN="+1,",NEW=1
  1. ; Identification
  1. S FDA(F,PHIEN,.01)=SNAME,FDA(F,PHIEN,.05)=SNAME
  1. S NCPDPID=$G(@GL@("Identification",0,"NCPDPID",0)),FDA(F,PHIEN,10.1)=NCPDPID
  1. S STLICNUM=$G(@GL@("Identification",0,"StateLicenseNumber",0)),FDA(F,PHIEN,9.1)=STLICNUM
  1. S MCARENUM=$G(@GL@("Identification",0,"MedicareNumber",0)),FDA(F,PHIEN,9.2)=MCARENUM
  1. S MCAIDNUM=$G(@GL@("Identification",0,"MedicaidNumber",0)),FDA(F,PHIEN,9.3)=MCAIDNUM
  1. S UPIN=$G(@GL@("Identification",0,"UPIN",0)),FDA(F,PHIEN,9.4)=UPIN
  1. S DEANUM=$G(@GL@("Identification",0,"DEANumber",0)),FDA(F,PHIEN,10.3)=DEANUM
  1. ;S FDA(F,PHIEN,.04)=DEANUM
  1. S HIN=$G(@GL@("Identification",0,"HIN",0)),FDA(F,PHIEN,9.5)=HIN
  1. S NPI=$G(@GL@("Identification",0,"NPI",0)),FDA(F,PHIEN,10.2)=NPI
  1. S MDEF=$G(@GL@("Identification",0,"MutuallyDefined",0)),FDA(F,PHIEN,9.6)=MDEF
  1. S SPEC=$G(@GL@("Specialty",0)),FDA(F,PHIEN,1.8)=SPEC
  1. ; pharmacy address
  1. S PHADD=$$ADDRESS^PSOERXIU(GLADD)
  1. 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)
  1. S PHST=$$STRES^PSOERXA2(PHZIP,PHST)
  1. 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
  1. I 'NEW D Q
  1. .D FILE^DIE(,"FDA") K FDA
  1. .; pharmacy communication numbers - clear the old ones if this is an existing entry
  1. .S KPIEN=$P(PHIEN,",")
  1. .I KPIEN D ;P700
  1. ..D KILL^PSOERXIA(52.47,PHIEN,"7*")
  1. ..S ARRAY(52.47,PHIEN,8)="@"
  1. ..D UPDATE^DIE(,"ARRAY") K ARRAY
  1. .D COMM^PSOERXIU(GL,52.477,KPIEN,52.47,8)
  1. .; link the pharmacy to the eRx record
  1. .S FDA(52.49,ERXIEN_",",2.5)=KPIEN D FILE^DIE(,"FDA")
  1. .; end pharmacy communication numbers
  1. .; ----------
  1. .; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
  1. .D PRE^PSOERXIB(ERXIEN,MTYPE,"P",KPIEN)
  1. D UPDATE^DIE(,"FDA","NIEN") K FDA
  1. S NIENODE=$O(NIEN(0)),NIEN=$G(NIEN(NIENODE))
  1. ; pharmacy communication numbers
  1. D COMM^PSOERXIU(GL,52.477,NIEN,52.47,8)
  1. ; end pharmacy communication numbers
  1. ; ----------
  1. ; file pharmacist data into 52.47 and link (PRE handles the linking depending on type)
  1. D PRE^PSOERXIB(ERXIEN,MTYPE,"P",PHIEN)
  1. ; link the pharmacy to the eRx record
  1. S FDA(52.49,ERXIEN_",",2.5)=NIEN D FILE^DIE(,"FDA")
  1. Q