- PSOERXA2 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- ;;7.0;OUTPATIENT PHARMACY;**467,520,508**;DEC 1997;Build 295
- ;
- Q
- ;/BLB/ PSO*7.0*520 - BEGIN CHANGE ( ADD BOTH THE 'FAC' AND 'FIC' LINETAG TO YOUR ROUTINE )
- FAC(ERXIEN) ; facility
- N GL,IDTYPE,IDVAL,F,FIEN,IENS,FNAME,FACFDA,AL1,AL2,CITY,STATE,ZIP,PLQUAL,FACFDA,SIEN
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Facility",0))
- S F=52.49,FIEN="",IENS=ERXIEN_","
- S FNAME=$G(@GL@("FacilityName",0))
- S FACFDA(F,IENS,70.1)=FNAME
- S AL1=$G(@GL@("Address",0,"AddressLine1",0)),FACFDA(F,IENS,70.2)=AL1
- S AL2=$G(@GL@("Address",0,"AddressLine2",0)),FACFDA(F,IENS,70.3)=AL2
- S CITY=$G(@GL@("Address",0,"City",0)),FACFDA(F,IENS,70.4)=CITY
- S STATE=$G(@GL@("Address",0,"State",0))
- S ZIP=$G(@GL@("Address",0,"ZipCode",0)),FACFDA(F,IENS,70.6)=ZIP
- S SIEN=$$STRES(ZIP,STATE)
- S FACFDA(F,IENS,70.5)=SIEN
- S PLQUAL=$G(@GL@("Address",0,"PlaceLocationQualifier",0)),FACFDA(F,IENS,70.7)=PLQUAL
- D FILE^DIE(,"FACFDA","ERR") K FACFDA ;D FIC($P(FIEN,","))
- D FIC(ERXIEN)
- ; future enhancement - file ID types - requires modification to the current payer information subfile
- ; - THIS REQUIRES RESOLUTION OF THE PAYERID TYPE ISSUE ALONG WITH PRIOR AUTH VALUES, ETC.
- ;S IDTYPE="" F S IDTYPE=$O(@GL@("Identification",0,IDTYPE)) Q:IDTYPE="" D
- ;S IDVAL=$G(@GL@("Identification",0,IDTYPE,0))
- Q
- FIC(IEN) ;
- N IDTYP,IDVAL,FDA,I,CCNT,FIEN,FACFDA,IDCNT,ERR
- Q:'IEN
- S IENS=IEN_","
- S IDCNT=0
- K ^PS(52.49,IEN,71)
- S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
- .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
- .I IDNM="NCPDPID",$G(NCPDPID)']"" S NCPDPID=$G(IDVAL)
- .S IDARY(IDNM)=IDVAL
- .S IDFND=0
- .S SRCH=0 F S SRCH=$O(^PS(52.49,IEN,71,SRCH)) Q:'SRCH D
- ..I $$GET1^DIQ(52.4971,SRCH_","_IEN_",",.01)=IDNM D
- ...S IDFND=1
- ...S FACFDA(52.4971,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FACFDA","ERR") K FACFDA
- .Q:IDFND
- .S FACFDA(52.4971,"+1,"_IEN_",",.01)=IDNM
- .S FACFDA(52.4971,"+1,"_IEN_",",.02)=IDVAL
- .D UPDATE^DIE(,"FACFDA") K FACFDA
- ; clear out existing communication Numbers
- K ^PS(52.49,IEN,72)
- S I=-1 F S I=$O(@GL@("CommunicationNumbers",0,"Communication",I)) Q:I="" D
- .S CCNT=$G(CCNT)+1
- .S COMVAL=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
- .S COMTYP=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
- .S FACFDA(52.4972,"+"_CCNT_","_IEN_",",.01)=COMVAL
- .S FACFDA(52.4972,"+"_CCNT_","_IEN_",",.02)=COMTYP
- D UPDATE^DIE(,"FACFDA") K FACFDA
- Q
- ;/BLB/ PSO*7.0*520 - END CHANGE
- PHR(ERXIEN,MTYPE) ; pharamcy
- N GL,SNAME,AL1,AL2,CIT,STATE,ZIP,PLQUAL,COMTYP,COMVAL,I,F,EIENS,PHIEN,CCNT,NEW,SPEC,FDA,NEWPHIEN,GL2,FQUAL,FROM,SIEN
- N NCPDPID
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",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=""
- S EIENS=ERXIEN_","
- S SNAME=$G(@GL@("StoreName",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
- ; if we found a match, clear out the existing communication numbers and identification
- I PHIEN K ^PS(52.47,$P(PHIEN,","),3),^PS(52.47,$P(PHIEN,","),2)
- I '$G(PHIEN) S PHIEN="+1,",NEW=1,FDA(F,PHIEN,.01)=SNAME
- S FDA(F,PHIEN,.05)=SNAME
- S SPEC=$G(@GL@("Specialty",0)),FDA(F,PHIEN,1.8)=SPEC
- S AL1=$G(@GL@("Address",0,"AddressLine1",0)),FDA(F,PHIEN,1.1)=AL1
- S AL2=$G(@GL@("Address",0,"AddressLine2",0)),FDA(F,PHIEN,1.2)=AL2
- S CITY=$G(@GL@("Address",0,"City",0)),FDA(F,PHIEN,1.3)=CITY
- S STATE=$G(@GL@("Address",0,"State",0))
- S ZIP=$G(@GL@("Address",0,"ZipCode",0)),FDA(F,PHIEN,1.5)=ZIP
- S SIEN=$$STRES(ZIP,STATE)
- S FDA(F,PHIEN,1.4)=SIEN
- S PLQUAL=$G(@GL@("Address",0,"PlaceLocationQualifier",0)),FDA(F,PHIEN,1.7)=PLQUAL
- ; if this is an existing pharmacy entry, file the updates, communication values, and identification, then link to 52.49
- I 'NEW D Q
- .D FILE^DIE(,"FDA") K FDA D PHRIC($P(PHIEN,","))
- .S FDA(52.49,EIENS,2.5)=$P(PHIEN,",") D FILE^DIE(,"FDA") K FDA
- ; for a new entry, file the entry, then file communication/identification and link to 52.49
- D UPDATE^DIE(,"FDA","NEWPHIEN") K FDA
- S PHIEN=$O(NEWPHIEN(0)),PHIEN=$G(NEWPHIEN(PHIEN))
- Q:'PHIEN
- D PHRIC(PHIEN)
- S FDA(52.49,EIENS,2.5)=PHIEN D FILE^DIE(,"FDA") K FDA
- Q
- PHRIC(IEN) ; pharmacy identification and communication information
- N IDTYP,IDVAL,FDA,I,CCNT,PHIEN,FDA,IDCNT
- Q:'IEN
- S PHIEN=IEN_","
- S IDCNT=0
- K ^PS(52.47,IEN,2)
- S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
- .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
- .I IDNM="NCPDPID",$G(NCPDPID)']"" S NCPDPID=$G(IDVAL)
- .S IDARY(IDNM)=IDVAL
- .S IDFND=0
- .S SRCH=0 F S SRCH=$O(^PS(52.47,IEN,2,SRCH)) Q:'SRCH D
- ..I $$GET1^DIQ(52.472,SRCH_","_IEN_",",.01)=IDNM D
- ...S IDFND=1
- ...S FDA(52.472,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
- .Q:IDFND
- .S FDA(52.472,"+1,"_IEN_",",.01)=IDNM
- .S FDA(52.472,"+1,"_IEN_",",.02)=IDVAL
- .D UPDATE^DIE(,"FDA") K FDA
- I $G(NCPDPID)]"" S FDA(52.47,PHIEN,.02)=NCPDPID D FILE^DIE(,"FDA") K FDA
- ; clear out existing communication Numbers
- K ^PS(52.47,IEN,3)
- S I=-1 F S I=$O(@GL@("CommunicationNumbers",0,"Communication",I)) Q:I="" D
- .S CCNT=$G(CCNT)+1
- .S COMVAL=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
- .S COMTYP=$G(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
- .S FDA(52.473,"+"_CCNT_","_PHIEN,.01)=COMVAL
- .S FDA(52.473,"+"_CCNT_","_PHIEN,.02)=COMTYP
- D UPDATE^DIE(,"FDA") K FDA
- Q
- PRE(ERXIEN,MTYPE) ; 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
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Prescriber",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="D",FROM]"" S PNPI=FROM
- S F=52.48
- S EIENS=ERXIEN_","
- S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
- S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0)))
- S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
- S FULLNM=LN_","_FN_$S(MN]"":" "_MN,1:"")
- S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
- S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
- S AL1=$G(@GL@("Address",0,"AddressLine1",0))
- S AL2=$G(@GL@("Address",0,"AddressLine2",0))
- S CITY=$G(@GL@("Address",0,"City",0))
- S STATE=$G(@GL@("Address",0,"State",0))
- S ZIP=$G(@GL@("Address",0,"ZipCode",0))
- S SIEN=$$STRES(ZIP,STATE)
- S SPEC=$G(@GL@("Specialty",0))
- S AFN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"FirstName",0)))
- S ALN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"LastName",0)))
- S AMN=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"MiddleName",0)))
- S APREF=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"Prefix",0)))
- S ASUFF=$$UP^XLFSTR($G(@GL@("PrescriberAgent",0,"Suffix",0)))
- ; 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))
- S PDEA=$G(@GL@("Identification",0,"DEANumber",0))
- S STLIC=$G(@GL@("Identification",0,"StateLicenseNumber",0))
- S PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$G(PNPI),PDEA) I PRVIEN S NEW=0
- I 'PRVIEN S NEW=1,PRVIEN="+1"
- S PRVIENS=PRVIEN_","
- 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
- S FDA(F,PRVIENS,.06)=PREF,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
- 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
- S FDA(F,PRVIENS,1.2)=SPEC
- S FDA(F,PRVIENS,1.8)=$G(STLIC)
- S FDA(F,PRVIENS,1.1)="PR"
- I 'NEW D Q
- .D FILE^DIE(,"FDA")
- .D PRVCI(PRVIEN)
- .S FDA(52.49,EIENS,2.1)=PRVIEN D FILE^DIE(,"FDA") K FDA
- D UPDATE^DIE(,"FDA","NEWIEN") K FDA
- S NPIEN=$O(NEWIEN(0)),NPIEN=$G(NEWIEN(NPIEN))
- D PRVCI(NPIEN)
- S FDA(52.49,EIENS,2.1)=NPIEN D FILE^DIE(,"FDA") K FDA
- Q
- PRVCI(IEN) ;
- N IENS,C,CQUAL,CVAL,FDA,IDNM,IDVAL,IDARY,IDFND,SRCH,NCPDPID,PHIN,DEA,STLIC,PNPI
- S IENS=IEN_","
- ; kill off existing data
- K ^PS(52.48,IEN,3)
- S C=-1 F S C=$O(@GL@("CommunicationNumbers",0,"Communication",C)) Q:C="" D
- .S CQUAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
- .S CVAL=$G(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
- .S FDA(52.483,"+1,"_IENS,.01)=CVAL
- .S FDA(52.483,"+1,"_IENS,.02)=CQUAL
- .D UPDATE^DIE(,"FDA") K FDA
- ; kill existing Identification data.
- K ^PS(52.48,IEN,6)
- S IDNM="" F S IDNM=$O(@GL@("Identification",0,IDNM)) Q:IDNM="" D
- .S IDVAL=$G(@GL@("Identification",0,IDNM,0))
- .S IDARY(IDNM)=IDVAL
- .I IDNM="NCPDPID" S NCPDPID=IDVAL
- .I IDNM="HIN" S PHIN=IDVAL
- .I IDNM="DEANumber" S DEA=IDVAL
- .I IDNM="StateLicenseNumber" S STLIC=IDVAL
- .I IDNM="NPI" S PNPI=IDVAL
- .S IDFND=0
- .S SRCH=0 F S SRCH=$O(^PS(52.48,IEN,6,SRCH)) Q:'SRCH D
- ..I $$GET1^DIQ(52.486,SRCH_","_IEN_",",.01)=IDNM D
- ...S IDFND=1
- ...S FDA(52.486,SRCH_","_IEN_",",.02)=IDVAL D FILE^DIE(,"FDA") K FDA
- .Q:IDFND
- .S FDA(52.486,"+1,"_IEN_",",.01)=IDNM
- .S FDA(52.486,"+1,"_IEN_",",.02)=IDVAL
- .D UPDATE^DIE(,"FDA") K FDA
- 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)
- D FILE^DIE(,"FDA") K FDA
- Q
- REQ ; request
- N GL,CRTYPE,RETREC,RRNUM
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Request",0))
- S CRTYPE=$G(@GL@("ChangeRequestType",0))
- S RETREC=$G(@GL@("ReturnReceipt",0))
- S RRNUM=$G(@GL@("RequestReferenceNumber",0))
- ; FUTURE ENHANCEMENT - file this information when we are getting other request types.
- Q
- SUP(ERXIEN,MTYPE) ; supervisor
- 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
- N FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,FDA,IDFND,SRCH,PNPI,PDEA,STLIC,SIEN
- S GL=$NA(^TMP($J,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Supervisor",0))
- S EIENS=ERXIEN_","
- S FN=$$UP^XLFSTR($G(@GL@("Name",0,"FirstName",0)))
- S LN=$$UP^XLFSTR($G(@GL@("Name",0,"LastName",0))) Q:'$L(LN)
- S MN=$$UP^XLFSTR($G(@GL@("Name",0,"MiddleName",0)))
- S FULLNM=LN_","_FN_$S(MN]"":" "_MN,1:"")
- S SUFF=$$UP^XLFSTR($G(@GL@("Name",0,"Suffix",0)))
- S PREF=$$UP^XLFSTR($G(@GL@("Name",0,"Prefix",0)))
- S AL1=$G(@GL@("Address",0,"AddressLine1",0))
- S AL2=$G(@GL@("Address",0,"AddressLine2",0))
- S CITY=$G(@GL@("Address",0,"City",0))
- S STATE=$G(@GL@("Address",0,"State",0))
- S ZIP=$G(@GL@("Address",0,"ZipCode",0))
- S SIEN=$$STRES(ZIP,STATE)
- S SPEC=$G(@GL@("Specialty",0))
- S PNPI=$G(@GL@("Identification",0,"NPI",0))
- S PDEA=$G(@GL@("Identification",0,"DEANumber",0))
- S STLIC=$G(@GL@("Identification",0,"StateLicenseNumber",0))
- S PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$G(PNPI),$G(PDEA)) I PRVIEN S NEW=0
- I 'PRVIEN S NEW=1,PRVIEN="+1"
- S PRVIENS=PRVIEN_","
- 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
- S FDA(F,PRVIENS,.06)=PREF,FDA(F,PRVIENS,4.1)=AL1,FDA(F,PRVIENS,4.2)=AL2,FDA(F,PRVIENS,4.3)=CITY
- ; STATE AND POINTER RESOLUTION
- S FDA(F,PRVIENS,4.4)=SIEN,FDA(F,PRVIENS,4.5)=ZIP
- S FDA(F,PRVIENS,1.2)=SPEC
- S FDA(F,PRVIENS,1.1)="S"
- I 'NEW D Q
- .D FILE^DIE(,"FDA") K FDA
- .D PRVCI(PRVIEN)
- .S FDA(52.49,EIENS,2.6)=PRVIEN D FILE^DIE(,"FDA") K FDA
- D UPDATE^DIE(,"FDA","NEWIEN") K FDA
- S NPIEN=$O(NEWIEN(0)),NPIEN=$G(NEWIEN(NPIEN))
- D PRVCI(NPIEN)
- S FDA(52.49,EIENS,2.6)=NPIEN D FILE^DIE(,"FDA") K FDA
- Q
- STRES(ZIP,STATE) ;
- N ZIPRES,SIEN
- S SIEN=""
- D POSTAL^XIPUTIL($E(ZIP,1,5),.ZIPRES) I $G(ZIPRES("STATE POINTER"))>0 S SIEN=$G(ZIPRES("STATE POINTER"))
- I 'SIEN,STATE]"" S SIEN=$$FIND1^DIC(5,,,STATE,"C")
- I 'SIEN,STATE]"" S SIEN=$O(^DIC(5,"C",STATE,0))
- Q SIEN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXA2 12114 printed Jan 18, 2025@03:29:30 Page 2
- PSOERXA2 ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**467,520,508**;DEC 1997;Build 295
- +2 ;
- +3 QUIT
- +4 ;/BLB/ PSO*7.0*520 - BEGIN CHANGE ( ADD BOTH THE 'FAC' AND 'FIC' LINETAG TO YOUR ROUTINE )
- FAC(ERXIEN) ; facility
- +1 NEW GL,IDTYPE,IDVAL,F,FIEN,IENS,FNAME,FACFDA,AL1,AL2,CITY,STATE,ZIP,PLQUAL,FACFDA,SIEN
- +2 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Facility",0))
- +3 SET F=52.49
- SET FIEN=""
- SET IENS=ERXIEN_","
- +4 SET FNAME=$GET(@GL@("FacilityName",0))
- +5 SET FACFDA(F,IENS,70.1)=FNAME
- +6 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
- SET FACFDA(F,IENS,70.2)=AL1
- +7 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
- SET FACFDA(F,IENS,70.3)=AL2
- +8 SET CITY=$GET(@GL@("Address",0,"City",0))
- SET FACFDA(F,IENS,70.4)=CITY
- +9 SET STATE=$GET(@GL@("Address",0,"State",0))
- +10 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
- SET FACFDA(F,IENS,70.6)=ZIP
- +11 SET SIEN=$$STRES(ZIP,STATE)
- +12 SET FACFDA(F,IENS,70.5)=SIEN
- +13 SET PLQUAL=$GET(@GL@("Address",0,"PlaceLocationQualifier",0))
- SET FACFDA(F,IENS,70.7)=PLQUAL
- +14 ;D FIC($P(FIEN,","))
- DO FILE^DIE(,"FACFDA","ERR")
- KILL FACFDA
- +15 DO FIC(ERXIEN)
- +16 ; future enhancement - file ID types - requires modification to the current payer information subfile
- +17 ; - THIS REQUIRES RESOLUTION OF THE PAYERID TYPE ISSUE ALONG WITH PRIOR AUTH VALUES, ETC.
- +18 ;S IDTYPE="" F S IDTYPE=$O(@GL@("Identification",0,IDTYPE)) Q:IDTYPE="" D
- +19 ;S IDVAL=$G(@GL@("Identification",0,IDTYPE,0))
- +20 QUIT
- FIC(IEN) ;
- +1 NEW IDTYP,IDVAL,FDA,I,CCNT,FIEN,FACFDA,IDCNT,ERR
- +2 if 'IEN
- QUIT
- +3 SET IENS=IEN_","
- +4 SET IDCNT=0
- +5 KILL ^PS(52.49,IEN,71)
- +6 SET IDNM=""
- FOR
- SET IDNM=$ORDER(@GL@("Identification",0,IDNM))
- if IDNM=""
- QUIT
- Begin DoDot:1
- +7 SET IDVAL=$GET(@GL@("Identification",0,IDNM,0))
- +8 IF IDNM="NCPDPID"
- IF $GET(NCPDPID)']""
- SET NCPDPID=$GET(IDVAL)
- +9 SET IDARY(IDNM)=IDVAL
- +10 SET IDFND=0
- +11 SET SRCH=0
- FOR
- SET SRCH=$ORDER(^PS(52.49,IEN,71,SRCH))
- if 'SRCH
- QUIT
- Begin DoDot:2
- +12 IF $$GET1^DIQ(52.4971,SRCH_","_IEN_",",.01)=IDNM
- Begin DoDot:3
- +13 SET IDFND=1
- +14 SET FACFDA(52.4971,SRCH_","_IEN_",",.02)=IDVAL
- DO FILE^DIE(,"FACFDA","ERR")
- KILL FACFDA
- End DoDot:3
- End DoDot:2
- +15 if IDFND
- QUIT
- +16 SET FACFDA(52.4971,"+1,"_IEN_",",.01)=IDNM
- +17 SET FACFDA(52.4971,"+1,"_IEN_",",.02)=IDVAL
- +18 DO UPDATE^DIE(,"FACFDA")
- KILL FACFDA
- End DoDot:1
- +19 ; clear out existing communication Numbers
- +20 KILL ^PS(52.49,IEN,72)
- +21 SET I=-1
- FOR
- SET I=$ORDER(@GL@("CommunicationNumbers",0,"Communication",I))
- if I=""
- QUIT
- Begin DoDot:1
- +22 SET CCNT=$GET(CCNT)+1
- +23 SET COMVAL=$GET(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
- +24 SET COMTYP=$GET(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
- +25 SET FACFDA(52.4972,"+"_CCNT_","_IEN_",",.01)=COMVAL
- +26 SET FACFDA(52.4972,"+"_CCNT_","_IEN_",",.02)=COMTYP
- End DoDot:1
- +27 DO UPDATE^DIE(,"FACFDA")
- KILL FACFDA
- +28 QUIT
- +29 ;/BLB/ PSO*7.0*520 - END CHANGE
- PHR(ERXIEN,MTYPE) ; pharamcy
- +1 NEW GL,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
- +3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Pharmacy",0))
- +4 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
- +5 SET FQUAL=$GET(@GL2@("From","A","Qualifier"))
- +6 SET FROM=$GET(@GL@("From",0))
- +7 IF FQUAL="P"
- IF FROM]""
- SET NCPDPID=FROM
- +8 SET F=52.47
- SET PHIEN=""
- +9 SET EIENS=ERXIEN_","
- +10 SET SNAME=$GET(@GL@("StoreName",0))
- +11 if '$LENGTH(SNAME)
- QUIT
- +12 IF $DATA(^PS(52.47,"B",SNAME))
- SET PHIEN=$ORDER(^PS(52.47,"B",SNAME,0))
- IF PHIEN
- SET PHIEN=PHIEN_","
- SET NEW=0
- +13 ; if we found a match, clear out the existing communication numbers and identification
- +14 IF PHIEN
- KILL ^PS(52.47,$PIECE(PHIEN,","),3),^PS(52.47,$PIECE(PHIEN,","),2)
- +15 IF '$GET(PHIEN)
- SET PHIEN="+1,"
- SET NEW=1
- SET FDA(F,PHIEN,.01)=SNAME
- +16 SET FDA(F,PHIEN,.05)=SNAME
- +17 SET SPEC=$GET(@GL@("Specialty",0))
- SET FDA(F,PHIEN,1.8)=SPEC
- +18 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
- SET FDA(F,PHIEN,1.1)=AL1
- +19 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
- SET FDA(F,PHIEN,1.2)=AL2
- +20 SET CITY=$GET(@GL@("Address",0,"City",0))
- SET FDA(F,PHIEN,1.3)=CITY
- +21 SET STATE=$GET(@GL@("Address",0,"State",0))
- +22 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
- SET FDA(F,PHIEN,1.5)=ZIP
- +23 SET SIEN=$$STRES(ZIP,STATE)
- +24 SET FDA(F,PHIEN,1.4)=SIEN
- +25 SET PLQUAL=$GET(@GL@("Address",0,"PlaceLocationQualifier",0))
- SET FDA(F,PHIEN,1.7)=PLQUAL
- +26 ; if this is an existing pharmacy entry, file the updates, communication values, and identification, then link to 52.49
- +27 IF 'NEW
- Begin DoDot:1
- +28 DO FILE^DIE(,"FDA")
- KILL FDA
- DO PHRIC($PIECE(PHIEN,","))
- +29 SET FDA(52.49,EIENS,2.5)=$PIECE(PHIEN,",")
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT
- +30 ; for a new entry, file the entry, then file communication/identification and link to 52.49
- +31 DO UPDATE^DIE(,"FDA","NEWPHIEN")
- KILL FDA
- +32 SET PHIEN=$ORDER(NEWPHIEN(0))
- SET PHIEN=$GET(NEWPHIEN(PHIEN))
- +33 if 'PHIEN
- QUIT
- +34 DO PHRIC(PHIEN)
- +35 SET FDA(52.49,EIENS,2.5)=PHIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- +36 QUIT
- PHRIC(IEN) ; pharmacy identification and communication information
- +1 NEW IDTYP,IDVAL,FDA,I,CCNT,PHIEN,FDA,IDCNT
- +2 if 'IEN
- QUIT
- +3 SET PHIEN=IEN_","
- +4 SET IDCNT=0
- +5 KILL ^PS(52.47,IEN,2)
- +6 SET IDNM=""
- FOR
- SET IDNM=$ORDER(@GL@("Identification",0,IDNM))
- if IDNM=""
- QUIT
- Begin DoDot:1
- +7 SET IDVAL=$GET(@GL@("Identification",0,IDNM,0))
- +8 IF IDNM="NCPDPID"
- IF $GET(NCPDPID)']""
- SET NCPDPID=$GET(IDVAL)
- +9 SET IDARY(IDNM)=IDVAL
- +10 SET IDFND=0
- +11 SET SRCH=0
- FOR
- SET SRCH=$ORDER(^PS(52.47,IEN,2,SRCH))
- if 'SRCH
- QUIT
- Begin DoDot:2
- +12 IF $$GET1^DIQ(52.472,SRCH_","_IEN_",",.01)=IDNM
- Begin DoDot:3
- +13 SET IDFND=1
- +14 SET FDA(52.472,SRCH_","_IEN_",",.02)=IDVAL
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:3
- End DoDot:2
- +15 if IDFND
- QUIT
- +16 SET FDA(52.472,"+1,"_IEN_",",.01)=IDNM
- +17 SET FDA(52.472,"+1,"_IEN_",",.02)=IDVAL
- +18 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +19 IF $GET(NCPDPID)]""
- SET FDA(52.47,PHIEN,.02)=NCPDPID
- DO FILE^DIE(,"FDA")
- KILL FDA
- +20 ; clear out existing communication Numbers
- +21 KILL ^PS(52.47,IEN,3)
- +22 SET I=-1
- FOR
- SET I=$ORDER(@GL@("CommunicationNumbers",0,"Communication",I))
- if I=""
- QUIT
- Begin DoDot:1
- +23 SET CCNT=$GET(CCNT)+1
- +24 SET COMVAL=$GET(@GL@("CommunicationNumbers",0,"Communication",I,"Number",0))
- +25 SET COMTYP=$GET(@GL@("CommunicationNumbers",0,"Communication",I,"Qualifier",0))
- +26 SET FDA(52.473,"+"_CCNT_","_PHIEN,.01)=COMVAL
- +27 SET FDA(52.473,"+"_CCNT_","_PHIEN,.02)=COMTYP
- End DoDot:1
- +28 DO UPDATE^DIE(,"FDA")
- KILL FDA
- +29 QUIT
- PRE(ERXIEN,MTYPE) ; 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
- +3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Prescriber",0))
- +4 SET GL2=$NAME(^TMP($JOB,"PSOERXO1","Message","A","Qualifier","Header","A","Qualifier"))
- +5 SET FQUAL=$GET(@GL2@("From","A","Qualifier"))
- +6 SET FROM=$GET(@GL@("From",0))
- +7 IF FQUAL="D"
- IF FROM]""
- SET PNPI=FROM
- +8 SET F=52.48
- +9 SET EIENS=ERXIEN_","
- +10 SET FN=$$UP^XLFSTR($GET(@GL@("Name",0,"FirstName",0)))
- +11 SET LN=$$UP^XLFSTR($GET(@GL@("Name",0,"LastName",0)))
- +12 SET MN=$$UP^XLFSTR($GET(@GL@("Name",0,"MiddleName",0)))
- +13 SET FULLNM=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
- +14 SET SUFF=$$UP^XLFSTR($GET(@GL@("Name",0,"Suffix",0)))
- +15 SET PREF=$$UP^XLFSTR($GET(@GL@("Name",0,"Prefix",0)))
- +16 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
- +17 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
- +18 SET CITY=$GET(@GL@("Address",0,"City",0))
- +19 SET STATE=$GET(@GL@("Address",0,"State",0))
- +20 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
- +21 SET SIEN=$$STRES(ZIP,STATE)
- +22 SET SPEC=$GET(@GL@("Specialty",0))
- +23 SET AFN=$$UP^XLFSTR($GET(@GL@("PrescriberAgent",0,"FirstName",0)))
- +24 SET ALN=$$UP^XLFSTR($GET(@GL@("PrescriberAgent",0,"LastName",0)))
- +25 SET AMN=$$UP^XLFSTR($GET(@GL@("PrescriberAgent",0,"MiddleName",0)))
- +26 SET APREF=$$UP^XLFSTR($GET(@GL@("PrescriberAgent",0,"Prefix",0)))
- +27 SET ASUFF=$$UP^XLFSTR($GET(@GL@("PrescriberAgent",0,"Suffix",0)))
- +28 ; try to match the provider/supervisor. if no match, create a new entry for this provider
- +29 ; if there is no NPI, grab it from the Identification multiple.
- +30 IF '$GET(PNPI)
- SET PNPI=$GET(@GL@("Identification",0,"NPI",0))
- +31 SET PDEA=$GET(@GL@("Identification",0,"DEANumber",0))
- +32 SET STLIC=$GET(@GL@("Identification",0,"StateLicenseNumber",0))
- +33 SET PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$GET(PNPI),PDEA)
- IF PRVIEN
- SET NEW=0
- +34 IF 'PRVIEN
- SET NEW=1
- SET PRVIEN="+1"
- +35 SET PRVIENS=PRVIEN_","
- +36 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
- +37 SET FDA(F,PRVIENS,.06)=PREF
- SET FDA(F,PRVIENS,4.1)=AL1
- SET FDA(F,PRVIENS,4.2)=AL2
- SET FDA(F,PRVIENS,4.3)=CITY
- +38 SET FDA(F,PRVIENS,4.4)=SIEN
- SET FDA(F,PRVIENS,4.5)=ZIP
- +39 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
- +40 SET FDA(F,PRVIENS,1.2)=SPEC
- +41 SET FDA(F,PRVIENS,1.8)=$GET(STLIC)
- +42 SET FDA(F,PRVIENS,1.1)="PR"
- +43 IF 'NEW
- Begin DoDot:1
- +44 DO FILE^DIE(,"FDA")
- +45 DO PRVCI(PRVIEN)
- +46 SET FDA(52.49,EIENS,2.1)=PRVIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT
- +47 DO UPDATE^DIE(,"FDA","NEWIEN")
- KILL FDA
- +48 SET NPIEN=$ORDER(NEWIEN(0))
- SET NPIEN=$GET(NEWIEN(NPIEN))
- +49 DO PRVCI(NPIEN)
- +50 SET FDA(52.49,EIENS,2.1)=NPIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- +51 QUIT
- PRVCI(IEN) ;
- +1 NEW IENS,C,CQUAL,CVAL,FDA,IDNM,IDVAL,IDARY,IDFND,SRCH,NCPDPID,PHIN,DEA,STLIC,PNPI
- +2 SET IENS=IEN_","
- +3 ; kill off existing data
- +4 KILL ^PS(52.48,IEN,3)
- +5 SET C=-1
- FOR
- SET C=$ORDER(@GL@("CommunicationNumbers",0,"Communication",C))
- if C=""
- QUIT
- Begin DoDot:1
- +6 SET CQUAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Qualifier",0))
- +7 SET CVAL=$GET(@GL@("CommunicationNumbers",0,"Communication",C,"Number",0))
- +8 SET FDA(52.483,"+1,"_IENS,.01)=CVAL
- +9 SET FDA(52.483,"+1,"_IENS,.02)=CQUAL
- +10 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +11 ; kill existing Identification data.
- +12 KILL ^PS(52.48,IEN,6)
- +13 SET IDNM=""
- FOR
- SET IDNM=$ORDER(@GL@("Identification",0,IDNM))
- if IDNM=""
- QUIT
- Begin DoDot:1
- +14 SET IDVAL=$GET(@GL@("Identification",0,IDNM,0))
- +15 SET IDARY(IDNM)=IDVAL
- +16 IF IDNM="NCPDPID"
- SET NCPDPID=IDVAL
- +17 IF IDNM="HIN"
- SET PHIN=IDVAL
- +18 IF IDNM="DEANumber"
- SET DEA=IDVAL
- +19 IF IDNM="StateLicenseNumber"
- SET STLIC=IDVAL
- +20 IF IDNM="NPI"
- SET PNPI=IDVAL
- +21 SET IDFND=0
- +22 SET SRCH=0
- FOR
- SET SRCH=$ORDER(^PS(52.48,IEN,6,SRCH))
- if 'SRCH
- QUIT
- Begin DoDot:2
- +23 IF $$GET1^DIQ(52.486,SRCH_","_IEN_",",.01)=IDNM
- Begin DoDot:3
- +24 SET IDFND=1
- +25 SET FDA(52.486,SRCH_","_IEN_",",.02)=IDVAL
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:3
- End DoDot:2
- +26 if IDFND
- QUIT
- +27 SET FDA(52.486,"+1,"_IEN_",",.01)=IDNM
- +28 SET FDA(52.486,"+1,"_IEN_",",.02)=IDVAL
- +29 DO UPDATE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- +30 SET FDA(52.48,IENS,1.4)=$GET(NCPDPID)
- SET FDA(52.48,IENS,1.5)=$GET(PNPI)
- SET FDA(52.48,IENS,1.6)=$GET(DEA)
- SET FDA(52.48,IENS,1.7)=$GET(PHIN)
- +31 DO FILE^DIE(,"FDA")
- KILL FDA
- +32 QUIT
- REQ ; request
- +1 NEW GL,CRTYPE,RETREC,RRNUM
- +2 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,"NewRx",0,"Request",0))
- +3 SET CRTYPE=$GET(@GL@("ChangeRequestType",0))
- +4 SET RETREC=$GET(@GL@("ReturnReceipt",0))
- +5 SET RRNUM=$GET(@GL@("RequestReferenceNumber",0))
- +6 ; FUTURE ENHANCEMENT - file this information when we are getting other request types.
- +7 QUIT
- SUP(ERXIEN,MTYPE) ; supervisor
- +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,EIENS
- +2 NEW FDA,NPIEN,NEW,PRVIEN,PRVIENS,NEWIEN,FDA,IDFND,SRCH,PNPI,PDEA,STLIC,SIEN
- +3 SET GL=$NAME(^TMP($JOB,"PSOERXO1","Message",0,"Body",0,MTYPE,0,"Supervisor",0))
- +4 SET EIENS=ERXIEN_","
- +5 SET FN=$$UP^XLFSTR($GET(@GL@("Name",0,"FirstName",0)))
- +6 SET LN=$$UP^XLFSTR($GET(@GL@("Name",0,"LastName",0)))
- if '$LENGTH(LN)
- QUIT
- +7 SET MN=$$UP^XLFSTR($GET(@GL@("Name",0,"MiddleName",0)))
- +8 SET FULLNM=LN_","_FN_$SELECT(MN]"":" "_MN,1:"")
- +9 SET SUFF=$$UP^XLFSTR($GET(@GL@("Name",0,"Suffix",0)))
- +10 SET PREF=$$UP^XLFSTR($GET(@GL@("Name",0,"Prefix",0)))
- +11 SET AL1=$GET(@GL@("Address",0,"AddressLine1",0))
- +12 SET AL2=$GET(@GL@("Address",0,"AddressLine2",0))
- +13 SET CITY=$GET(@GL@("Address",0,"City",0))
- +14 SET STATE=$GET(@GL@("Address",0,"State",0))
- +15 SET ZIP=$GET(@GL@("Address",0,"ZipCode",0))
- +16 SET SIEN=$$STRES(ZIP,STATE)
- +17 SET SPEC=$GET(@GL@("Specialty",0))
- +18 SET PNPI=$GET(@GL@("Identification",0,"NPI",0))
- +19 SET PDEA=$GET(@GL@("Identification",0,"DEANumber",0))
- +20 SET STLIC=$GET(@GL@("Identification",0,"StateLicenseNumber",0))
- +21 SET PRVIEN=$$FINDPRE^PSOERXU2(FULLNM,$GET(PNPI),$GET(PDEA))
- IF PRVIEN
- SET NEW=0
- +22 IF 'PRVIEN
- SET NEW=1
- SET PRVIEN="+1"
- +23 SET PRVIENS=PRVIEN_","
- +24 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
- +25 SET FDA(F,PRVIENS,.06)=PREF
- SET FDA(F,PRVIENS,4.1)=AL1
- SET FDA(F,PRVIENS,4.2)=AL2
- SET FDA(F,PRVIENS,4.3)=CITY
- +26 ; STATE AND POINTER RESOLUTION
- +27 SET FDA(F,PRVIENS,4.4)=SIEN
- SET FDA(F,PRVIENS,4.5)=ZIP
- +28 SET FDA(F,PRVIENS,1.2)=SPEC
- +29 SET FDA(F,PRVIENS,1.1)="S"
- +30 IF 'NEW
- Begin DoDot:1
- +31 DO FILE^DIE(,"FDA")
- KILL FDA
- +32 DO PRVCI(PRVIEN)
- +33 SET FDA(52.49,EIENS,2.6)=PRVIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- End DoDot:1
- QUIT
- +34 DO UPDATE^DIE(,"FDA","NEWIEN")
- KILL FDA
- +35 SET NPIEN=$ORDER(NEWIEN(0))
- SET NPIEN=$GET(NEWIEN(NPIEN))
- +36 DO PRVCI(NPIEN)
- +37 SET FDA(52.49,EIENS,2.6)=NPIEN
- DO FILE^DIE(,"FDA")
- KILL FDA
- +38 QUIT
- STRES(ZIP,STATE) ;
- +1 NEW ZIPRES,SIEN
- +2 SET SIEN=""
- +3 DO POSTAL^XIPUTIL($EXTRACT(ZIP,1,5),.ZIPRES)
- IF $GET(ZIPRES("STATE POINTER"))>0
- SET SIEN=$GET(ZIPRES("STATE POINTER"))
- +4 IF 'SIEN
- IF STATE]""
- SET SIEN=$$FIND1^DIC(5,,,STATE,"C")
- +5 IF 'SIEN
- IF STATE]""
- SET SIEN=$ORDER(^DIC(5,"C",STATE,0))
- +6 QUIT SIEN