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

PSOERXA2.m

Go to the documentation of this file.
  1. PSOERXA2 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**467,520,508**;DEC 1997;Build 295
  1. ;
  1. Q
  1. ;/BLB/ PSO*7.0*520 - BEGIN CHANGE ( ADD BOTH THE 'FAC' AND 'FIC' LINETAG TO YOUR ROUTINE )
  1. FAC(ERXIEN) ; facility
  1. N GL,IDTYPE,IDVAL,F,FIEN,IENS,FNAME,FACFDA,AL1,AL2,CITY,STATE,ZIP,PLQUAL,FACFDA,SIEN
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Facility",0))
  1. S F=52.49,FIEN="",IENS=ERXIEN_","
  1. S FNAME=$G(@GL@("FacilityName",0))
  1. S FACFDA(F,IENS,70.1)=FNAME
  1. S AL1=$G(@GL@("Address",0,"AddressLine1",0)),FACFDA(F,IENS,70.2)=AL1
  1. S AL2=$G(@GL@("Address",0,"AddressLine2",0)),FACFDA(F,IENS,70.3)=AL2
  1. S CITY=$G(@GL@("Address",0,"City",0)),FACFDA(F,IENS,70.4)=CITY
  1. S STATE=$G(@GL@("Address",0,"State",0))
  1. S ZIP=$G(@GL@("Address",0,"ZipCode",0)),FACFDA(F,IENS,70.6)=ZIP
  1. S SIEN=$$STRES(ZIP,STATE)
  1. S FACFDA(F,IENS,70.5)=SIEN
  1. S PLQUAL=$G(@GL@("Address",0,"PlaceLocationQualifier",0)),FACFDA(F,IENS,70.7)=PLQUAL
  1. D FILE^DIE(,"FACFDA","ERR") K FACFDA ;D FIC($P(FIEN,","))
  1. D FIC(ERXIEN)
  1. ; future enhancement - file ID types - requires modification to the current payer information subfile
  1. ; - THIS REQUIRES RESOLUTION OF THE PAYERID TYPE ISSUE ALONG WITH PRIOR AUTH VALUES, ETC.
  1. ;S IDTYPE="" F S IDTYPE=$O(@GL@("Identification",0,IDTYPE)) Q:IDTYPE="" D
  1. ;S IDVAL=$G(@GL@("Identification",0,IDTYPE,0))
  1. Q
  1. FIC(IEN) ;
  1. N IDTYP,IDVAL,FDA,I,CCNT,FIEN,FACFDA,IDCNT,ERR
  1. Q:'IEN
  1. S IENS=IEN_","
  1. S IDCNT=0
  1. K ^PS(52.49,IEN,71)
  1. S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
  1. .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
  1. .I IDNM="NCPDPID",$G(NCPDPID)']"" S NCPDPID=$G(IDVAL)
  1. .S IDARY(IDNM)=IDVAL
  1. .S IDFND=0
  1. .S SRCH=0 F S SRCH=$O(^PS(52.49,IEN,71,SRCH)) Q:'SRCH D
  1. ..I $$GET1^DIQ(52.4971,SRCH_","_IEN_",",.01)=IDNM D
  1. ...S IDFND=1
  1. ...S FACFDA(52.4971,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FACFDA","ERR") K FACFDA
  1. .Q:IDFND
  1. .S FACFDA(52.4971,"+1,"_IEN_",",.01)=IDNM
  1. .S FACFDA(52.4971,"+1,"_IEN_",",.02)=IDVAL
  1. .D UPDATE^DIE(,"FACFDA") K FACFDA
  1. ; clear out existing communication Numbers
  1. K ^PS(52.49,IEN,72)
  1. S I=-1 F S I=$O(@GL@("CommunicationNumbers",0,"Communication",I)) Q:I="" D
  1. .S CCNT=$G(CCNT)+1
  1. .S COMVAL=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
  1. .S COMTYP=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
  1. .S FACFDA(52.4972,"+"_CCNT_","_IEN_",",.01)=COMVAL
  1. .S FACFDA(52.4972,"+"_CCNT_","_IEN_",",.02)=COMTYP
  1. D UPDATE^DIE(,"FACFDA") K FACFDA
  1. Q
  1. ;/BLB/ PSO*7.0*520 - END CHANGE
  1. PHR(ERXIEN,MTYPE) ; pharamcy
  1. N GL,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
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",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=""
  1. S EIENS=ERXIEN_","
  1. S SNAME=$G(@GL@("StoreName",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. ; if we found a match, clear out the existing communication numbers and identification
  1. I PHIEN K ^PS(52.47,$P(PHIEN,","),3),^PS(52.47,$P(PHIEN,","),2)
  1. I '$G(PHIEN) S PHIEN="+1,",NEW=1,FDA(F,PHIEN,.01)=SNAME
  1. S FDA(F,PHIEN,.05)=SNAME
  1. S SPEC=$G(@GL@("Specialty",0)),FDA(F,PHIEN,1.8)=SPEC
  1. S AL1=$G(@GL@("Address",0,"AddressLine1",0)),FDA(F,PHIEN,1.1)=AL1
  1. S AL2=$G(@GL@("Address",0,"AddressLine2",0)),FDA(F,PHIEN,1.2)=AL2
  1. S CITY=$G(@GL@("Address",0,"City",0)),FDA(F,PHIEN,1.3)=CITY
  1. S STATE=$G(@GL@("Address",0,"State",0))
  1. S ZIP=$G(@GL@("Address",0,"ZipCode",0)),FDA(F,PHIEN,1.5)=ZIP
  1. S SIEN=$$STRES(ZIP,STATE)
  1. S FDA(F,PHIEN,1.4)=SIEN
  1. S PLQUAL=$G(@GL@("Address",0,"PlaceLocationQualifier",0)),FDA(F,PHIEN,1.7)=PLQUAL
  1. ; if this is an existing pharmacy entry, file the updates, communication values, and identification, then link to 52.49
  1. I 'NEW D Q
  1. .D FILE^DIE(,"FDA") K FDA D PHRIC($P(PHIEN,","))
  1. .S FDA(52.49,EIENS,2.5)=$P(PHIEN,",") D FILE^DIE(,"FDA") K FDA
  1. ; for a new entry, file the entry, then file communication/identification and link to 52.49
  1. D UPDATE^DIE(,"FDA","NEWPHIEN") K FDA
  1. S PHIEN=$O(NEWPHIEN(0)),PHIEN=$G(NEWPHIEN(PHIEN))
  1. Q:'PHIEN
  1. D PHRIC(PHIEN)
  1. S FDA(52.49,EIENS,2.5)=PHIEN D FILE^DIE(,"FDA") K FDA
  1. Q
  1. PHRIC(IEN) ; pharmacy identification and communication information
  1. N IDTYP,IDVAL,FDA,I,CCNT,PHIEN,FDA,IDCNT
  1. Q:'IEN
  1. S PHIEN=IEN_","
  1. S IDCNT=0
  1. K ^PS(52.47,IEN,2)
  1. S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
  1. .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
  1. .I IDNM="NCPDPID",$G(NCPDPID)']"" S NCPDPID=$G(IDVAL)
  1. .S IDARY(IDNM)=IDVAL
  1. .S IDFND=0
  1. .S SRCH=0 F S SRCH=$O(^PS(52.47,IEN,2,SRCH)) Q:'SRCH D
  1. ..I $$GET1^DIQ(52.472,SRCH_","_IEN_",",.01)=IDNM D
  1. ...S IDFND=1
  1. ...S FDA(52.472,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
  1. .Q:IDFND
  1. .S FDA(52.472,"+1,"_IEN_",",.01)=IDNM
  1. .S FDA(52.472,"+1,"_IEN_",",.02)=IDVAL
  1. .D UPDATE^DIE(,"FDA") K FDA
  1. I $G(NCPDPID)]"" S FDA(52.47,PHIEN,.02)=NCPDPID D FILE^DIE(,"FDA") K FDA
  1. ; clear out existing communication Numbers
  1. K ^PS(52.47,IEN,3)
  1. S I=-1 F S I=$O(@GL@("CommunicationNumbers",0,"Communication",I)) Q:I="" D
  1. .S CCNT=$G(CCNT)+1
  1. .S COMVAL=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
  1. .S COMTYP=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
  1. .S FDA(52.473,"+"_CCNT_","_PHIEN,.01)=COMVAL
  1. .S FDA(52.473,"+"_CCNT_","_PHIEN,.02)=COMTYP
  1. D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. PRE(ERXIEN,MTYPE) ; prescriber
  1. 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
  1. N EIENS,FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,IDFND,SRCH,PNPI,PDEA,GL2,FQUAL,FROM,SIEN
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Prescriber",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="D",FROM]"" S PNPI=FROM
  1. S F=52.48
  1. S EIENS=ERXIEN_","
  1. S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
  1. S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0)))
  1. S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
  1. S FULLNM=LN_","_FN_$S(MN]"":" "_MN,1:"")
  1. S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
  1. S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
  1. S AL1=$G(@GL@("Address",0,"AddressLine1",0))
  1. S AL2=$G(@GL@("Address",0,"AddressLine2",0))
  1. S CITY=$G(@GL@("Address",0,"City",0))
  1. S STATE=$G(@GL@("Address",0,"State",0))
  1. S ZIP=$G(@GL@("Address",0,"ZipCode",0))
  1. S SIEN=$$STRES(ZIP,STATE)
  1. S SPEC=$G(@GL@("Specialty",0))
  1. S AFN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"FirstName",0)))
  1. S ALN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"LastName",0)))
  1. S AMN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"MiddleName",0)))
  1. S APREF=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"Prefix",0)))
  1. S ASUFF=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"Suffix",0)))
  1. ; try to match the provider/supervisor. if no match, create a new entry for this provider
  1. ; if there is no NPI, grab it from the Identification multiple.
  1. I '$G(PNPI) S PNPI=$G(@GL@("Identification",0,"NPI",0))
  1. S PDEA=$G(@GL@("Identification",0,"DEANumber",0))
  1. S STLIC=$G(@GL@("Identification",0,"StateLicenseNumber",0))
  1. S PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$G(PNPI),PDEA) I PRVIEN S NEW=0
  1. I 'PRVIEN S NEW=1,PRVIEN="+1"
  1. S PRVIENS=PRVIEN_","
  1. 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
  1. S FDA(F,PRVIENS,.06)=PREF,FDA(F,PRVIENS,4.1)=AL1,FDA(F,PRVIENS,4.2)=AL2,FDA(F,PRVIENS,4.3)=CITY
  1. S FDA(F,PRVIENS,4.4)=SIEN,FDA(F,PRVIENS,4.5)=ZIP
  1. 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
  1. S FDA(F,PRVIENS,1.2)=SPEC
  1. S FDA(F,PRVIENS,1.8)=$G(STLIC)
  1. S FDA(F,PRVIENS,1.1)="PR"
  1. I 'NEW D Q
  1. .D FILE^DIE(,"FDA")
  1. .D PRVCI(PRVIEN)
  1. .S FDA(52.49,EIENS,2.1)=PRVIEN D FILE^DIE(,"FDA") K FDA
  1. D UPDATE^DIE(,"FDA","NEWIEN") K FDA
  1. S NPIEN=$O(NEWIEN(0)),NPIEN=$G(NEWIEN(NPIEN))
  1. D PRVCI(NPIEN)
  1. S FDA(52.49,EIENS,2.1)=NPIEN D FILE^DIE(,"FDA") K FDA
  1. Q
  1. PRVCI(IEN) ;
  1. N IENS,C,CQUAL,CVAL,FDA,IDNM,IDVAL,IDARY,IDFND,SRCH,NCPDPID,PHIN,DEA,STLIC,PNPI
  1. S IENS=IEN_","
  1. ; kill off existing data
  1. K ^PS(52.48,IEN,3)
  1. S C=-1 F S C=$O(@GL@("CommunicationNumbers",0,"Communication",C)) Q:C="" D
  1. .S CQUAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
  1. .S CVAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
  1. .S FDA(52.483,"+1,"_IENS,.01)=CVAL
  1. .S FDA(52.483,"+1,"_IENS,.02)=CQUAL
  1. .D UPDATE^DIE(,"FDA") K FDA
  1. ; kill existing Identification data.
  1. K ^PS(52.48,IEN,6)
  1. S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
  1. .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
  1. .S IDARY(IDNM)=IDVAL
  1. .I IDNM="NCPDPID" S NCPDPID=IDVAL
  1. .I IDNM="HIN" S PHIN=IDVAL
  1. .I IDNM="DEANumber" S DEA=IDVAL
  1. .I IDNM="StateLicenseNumber" S STLIC=IDVAL
  1. .I IDNM="NPI" S PNPI=IDVAL
  1. .S IDFND=0
  1. .S SRCH=0 F S SRCH=$O(^PS(52.48,IEN,6,SRCH)) Q:'SRCH D
  1. ..I $$GET1^DIQ(52.486,SRCH_","_IEN_",",.01)=IDNM D
  1. ...S IDFND=1
  1. ...S FDA(52.486,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
  1. .Q:IDFND
  1. .S FDA(52.486,"+1,"_IEN_",",.01)=IDNM
  1. .S FDA(52.486,"+1,"_IEN_",",.02)=IDVAL
  1. .D UPDATE^DIE(,"FDA") K FDA
  1. S FDA(52.48,IENS,1.4)=$G(NCPDPID),FDA(52.48,IENS,1.5)=$G(PNPI),FDA(52.48,IENS,1.6)=$G(DEA),FDA(52.48,IENS,1.7)=$G(PHIN)
  1. D FILE^DIE(,"FDA") K FDA
  1. Q
  1. REQ ; request
  1. N GL,CRTYPE,RETREC,RRNUM
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Request",0))
  1. S CRTYPE=$G(@GL@("ChangeRequestType",0))
  1. S RETREC=$G(@GL@("ReturnReceipt",0))
  1. S RRNUM=$G(@GL@("RequestReferenceNumber",0))
  1. ; FUTURE ENHANCEMENT - file this information when we are getting other request types.
  1. Q
  1. SUP(ERXIEN,MTYPE) ; supervisor
  1. 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,EIENS
  1. N FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,FDA,IDFND,SRCH,PNPI,PDEA,STLIC,SIEN
  1. S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Supervisor",0))
  1. S EIENS=ERXIEN_","
  1. S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
  1. S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0))) Q:'$L(LN)
  1. S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
  1. S FULLNM=LN_","_FN_$S(MN]"":" "_MN,1:"")
  1. S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
  1. S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
  1. S AL1=$G(@GL@("Address",0,"AddressLine1",0))
  1. S AL2=$G(@GL@("Address",0,"AddressLine2",0))
  1. S CITY=$G(@GL@("Address",0,"City",0))
  1. S STATE=$G(@GL@("Address",0,"State",0))
  1. S ZIP=$G(@GL@("Address",0,"ZipCode",0))
  1. S SIEN=$$STRES(ZIP,STATE)
  1. S SPEC=$G(@GL@("Specialty",0))
  1. S PNPI=$G(@GL@("Identification",0,"NPI",0))
  1. S PDEA=$G(@GL@("Identification",0,"DEANumber",0))
  1. S STLIC=$G(@GL@("Identification",0,"StateLicenseNumber",0))
  1. S PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$G(PNPI),$G(PDEA)) I PRVIEN S NEW=0
  1. I 'PRVIEN S NEW=1,PRVIEN="+1"
  1. S PRVIENS=PRVIEN_","
  1. 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
  1. S FDA(F,PRVIENS,.06)=PREF,FDA(F,PRVIENS,4.1)=AL1,FDA(F,PRVIENS,4.2)=AL2,FDA(F,PRVIENS,4.3)=CITY
  1. ; STATE AND POINTER RESOLUTION
  1. S FDA(F,PRVIENS,4.4)=SIEN,FDA(F,PRVIENS,4.5)=ZIP
  1. S FDA(F,PRVIENS,1.2)=SPEC
  1. S FDA(F,PRVIENS,1.1)="S"
  1. I 'NEW D Q
  1. .D FILE^DIE(,"FDA") K FDA
  1. .D PRVCI(PRVIEN)
  1. .S FDA(52.49,EIENS,2.6)=PRVIEN D FILE^DIE(,"FDA") K FDA
  1. D UPDATE^DIE(,"FDA","NEWIEN") K FDA
  1. S NPIEN=$O(NEWIEN(0)),NPIEN=$G(NEWIEN(NPIEN))
  1. D PRVCI(NPIEN)
  1. S FDA(52.49,EIENS,2.6)=NPIEN D FILE^DIE(,"FDA") K FDA
  1. Q
  1. STRES(ZIP,STATE) ;
  1. N ZIPRES,SIEN
  1. S SIEN=""
  1. D POSTAL^XIPUTIL($E(ZIP,1,5),.ZIPRES) I $G(ZIPRES("STATE POINTER"))>0 S SIEN=$G(ZIPRES("STATE POINTER"))
  1. I 'SIEN,STATE]"" S SIEN=$$FIND1^DIC(5,,,STATE,"C")
  1. I 'SIEN,STATE]"" S SIEN=$O(^DIC(5,"C",STATE,0))
  1. Q SIEN