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

PSOERXOD.m

Go to the documentation of this file.
  1. PSOERXOD ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
  1. ;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
  1. ;
  1. Q
  1. ;
  1. ;/JSG/ POS*7.0*581 - BEGIN CHANGE
  1. OPHARM(GBL,CNT,PSOSITE,PSOIEN) ; Adapted from VAPHARM^PSOERXX2
  1. N ADDL1,ADDL18,ADDL2,ADDL28,BNAME7,BNAME8,CITY,CITY8,CNTRY,CNTRY8
  1. N DEA7,DEA8,F,F2,FFNAME,FLNAME,FMNAME,FNAME,FPREF,FSUFF,HIN7,ID
  1. N IEN,IENS,LNAME,MEDICAI7,MEDICAI8,MEDICAR7,MEDICAR8,MNAME
  1. N MUTDEF7,MUTDEF8,NCPDPID7,NPI,NPI7,NPI8,PARAMS,PHARDAT,PHIEN,PHIENS
  1. N PHRMCIST,PREF,SGBL7,SGBL8,SPEC,STATE,STATE8,STLICNO7,STLICNO8,STNM
  1. N SUFF,TXT,UPIN7,UPIN8,ZIP,ZIP8,INST,CNTRYIEN
  1. S F=52.47,F2=52.48
  1. S IEN=$$GET1^DIQ(52.49,PSOIEN,2.5,"I")
  1. I 'IEN D LOCAL(GBL,.CNT,PSOSITE,PSOIEN) Q
  1. S IENS=IEN_","
  1. D GETS^DIQ(F,IENS,"**","IE","PHARDAT")
  1. S PHIEN=$G(PHARDAT(F,IENS,4,"I"))
  1. S PHIENS=PHIEN_","
  1. D GETS^DIQ(F2,PHIENS,"**","IE","PHRMCIST")
  1. D CONVXML^PSOERXX1("PHARDAT"),CONVXML^PSOERXX1("PHRMCIST")
  1. S LNAME=$G(PHRMCIST(F2,PHIENS,.02,"E"))
  1. S FNAME=$G(PHRMCIST(F2,PHIENS,.03,"E"))
  1. S MNAME=$G(PHRMCIST(F2,PHIENS,.04,"E"))
  1. S SUFF=$G(PHRMCIST(F2,PHIENS,.05,"E"))
  1. S PREF=$G(PHRMCIST(F2,PHIENS,.06,"E"))
  1. S NPI=$G(PHRMCIST(F2,PHIENS,15.1,"E"))
  1. S STNM=$G(PHARDAT(F,IENS,.01,"E"))
  1. S ADDL1=$G(PHARDAT(F,IENS,1.1,"E"))
  1. S ADDL2=$G(PHARDAT(F,IENS,1.2,"E"))
  1. S CITY=$G(PHARDAT(F,IENS,1.3,"E"))
  1. S STATE=$G(PHARDAT(F,IENS,1.4,"I"))
  1. S ZIP=$G(PHARDAT(F,IENS,1.5,"E")),ZIP=$TR(ZIP,"-","")
  1. S CNTRY=$G(PHARDAT(F,IENS,1.7,"E"))
  1. ; country code is required on an rxRenewalRequest, try to get it from the Institution file
  1. I CNTRY']"" S CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
  1. ; address missing from NewRx
  1. I $G(ADDL1)="" D
  1. .S ADDL1=$$GET1^DIQ(59,PSOSITE,.02,"E")
  1. .S ADDL2=""
  1. .S CITY=$$GET1^DIQ(59,PSOSITE,.07,"E")
  1. .S STATE=$$GET1^DIQ(59,PSOSITE,.08,"I")
  1. .I STATE S STATE=$$GET1^DIQ(5,STATE,1,"E")
  1. .S ZIP=$E($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
  1. .S CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
  1. ; default to US if country code could not be found (per PBM 10/27/2020).
  1. I CNTRY']"" S CNTRY="US"
  1. ; VARIABLES ENDING IN 7 <-> File #52.47
  1. ; VARIABLES ENDING IN 7 <-> File #52.48
  1. S SPEC=$G(PHARDAT(F,IENS,1.8,"E"))
  1. S NCPDPID7=$G(PHARDAT(F,IENS,10.1,"E"))
  1. S STLICNO7=$G(PHARDAT(F,IENS,9.1,"E"))
  1. S MEDICAR7=$G(PHARDAT(F,IENS,9.2,"E"))
  1. S MEDICAI7=$G(PHARDAT(F,IENS,9.3,"E"))
  1. S UPIN7=$G(PHARDAT(F,IENS,9.4,"E"))
  1. S DEA7=$G(PHARDAT(F,IENS,10.3,"E"))
  1. S HIN7=$G(PHARDAT(F,IENS,9.5,"E"))
  1. S NPI7=$G(PHARDAT(F,IENS,10.2,"E"))
  1. S MUTDEF7=$G(PHARDAT(F,IENS,9.6,"E"))
  1. S BNAME7=$G(PHARDAT(F,IENS,.01,"E")) S:BNAME7="" BNAME7=$G(PHARDAT(F,IENS,.05,"E"))
  1. S FLNAME=$G(PHRMCIST(F2,PHIENS,2.4,"E"))
  1. S FFNAME=$G(PHRMCIST(F2,PHIENS,2.5,"E"))
  1. S FMNAME=$G(PHRMCIST(F2,PHIENS,2.6,"E"))
  1. S FSUFF=$G(PHRMCIST(F2,PHIENS,2.7,"E"))
  1. S FPREF=$G(PHRMCIST(F2,PHIENS,2.8,"E"))
  1. S ADDL18=$G(PHRMCIST(F2,PHIENS,4.1,"E"))
  1. S ADDL28=$G(PHRMCIST(F2,PHIENS,4.2,"E"))
  1. S CITY8=$G(PHRMCIST(F2,PHIENS,4.3,"E"))
  1. S STATE8=$G(PHRMCIST(F2,PHIENS,4.4,"I"))
  1. S ZIP8=$G(PHRMCIST(F2,PHIENS,4.5,"E"))
  1. S CNTRY8=$G(PHRMCIST(F2,PHIENS,2.2,"E"))
  1. S BNAME8=$G(PHRMCIST(F2,PHIENS,2.1,"E"))
  1. S STLICNO8=$G(PHRMCIST(F2,PHIENS,14.1,"E"))
  1. S MEDICAR8=$G(PHRMCIST(F2,PHIENS,14.2,"E"))
  1. S MEDICAI8=$G(PHRMCIST(F2,PHIENS,14.3,"E"))
  1. S UPIN8=$G(PHRMCIST(F2,PHIENS,14.4,"E"))
  1. S DEA8=$G(PHRMCIST(F2,PHIENS,14.5,"E"))
  1. S NPI8=$G(PHRMCIST(F2,PHIENS,15.1,"E"))
  1. S MUTDEF8=$G(PHRMCIST(F2,PHIENS,15.4,"E"))
  1. S SGBL7=$NA(^PS(52.47,IEN,7))
  1. S SGBL8=$NA(^PS(52.48,PHIEN,11))
  1. ;
  1. ; Create Pharmacy structure
  1. ;
  1. I NCPDPID7'="",NPI7'="",BNAME7'="" D
  1. .D C S @GBL@(CNT,0)="<Pharmacy>"
  1. .D ; Identification
  1. ..S PARAMS="NCPDPID,NCPDPID7^StateLicenseNumber,STLICNO7"
  1. ..S PARAMS=PARAMS_"^MedicareNumber,MEDICAR7^MedicaidNumber,MEDICAI7"
  1. ..S PARAMS=PARAMS_"^UPIN,UPIN7^DEANumber,DEA7^HIN,HIN7"
  1. ..S PARAMS=PARAMS_"^NPI,NPI7^MutuallyDefined,MUTDEF7"
  1. ..D OID(GBL,.CNT,PARAMS,STLICNO7,MEDICAR7,MEDICAI7,UPIN7,DEA7,NPI7,MUTDEF7,NCPDPID7,HIN7)
  1. .D BL(GBL,.CNT,"Specialty",SPEC)
  1. .I LNAME'="",FNAME'="" D
  1. ..D PHARMCST(GBL,.CNT,STLICNO8,MEDICAR8,MEDICAI8,UPIN8,DEA8,NPI8,MUTDEF8,LNAME,FNAME,MNAME,SUFF,PREF,FLNAME,FFNAME,FMNAME,FSUFF,FPREF,BNAME8,ADDL18,ADDL28,CITY8,STATE8,ZIP8,CNTRY8,SGBL8,PHIENS)
  1. .D C S @GBL@(CNT,0)="<BusinessName>"_BNAME7_"</BusinessName>"
  1. .D:$L(ADDL1_ADDL2_CITY_STATE_ZIP_CNTRY) ; Address
  1. ..D OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
  1. .D OCOMM^PSOERXOU(GBL,SGBL7,.CNT,IENS,52.477,52.47,8,IENS)
  1. .D C S @GBL@(CNT,0)="</Pharmacy>"
  1. Q
  1. ;
  1. OPHARMD ;;
  1. ;;NCPDPID7;STLICNO7;MEDICAR7;MEDICAI7;UPIN7;DEA7;HIN7;NPI7;MUTDEF7
  1. ;;SPEC;STLICNO8;MEDICAR8;MEDICAI8;UPIN8;DEA8;NPI8;MUTDEF8;BNAME7
  1. ;;ADDL1;ADDL2;CITY;STATE;ZIP;CNTRY
  1. ;;***END***
  1. ;/JSG/ - END CHANGE
  1. ;
  1. PHARMCST(GBL,CNT,SLN,MEDICARE,MEDICAID,UPIN,DEA,NPI,MUTUALDE,LNAME,FNAME,MNAME,SUFF,PREF,FLNAME,FFNAME,FMNAME,FSUFF,FPREF,BNAME,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY,SGBL8,PHIENS) ; Create Pharmaticist structure
  1. N SUBFILE
  1. D C S @GBL@(CNT,0)="<Pharmacist>"
  1. ;Identification
  1. I $L(SLN_MEDICARE_MEDICAID_UPIN_DEA_NPI_MUTUALDE) D
  1. .D OID(GBL,.CNT,"StateLicenseNumber,SLN^MedicareNumber,MEDICARE^MedicaidNumber,MEDICAID^UPIN,UPIN^DEANumber,DEA^NPI,NPI^MutuallyDefined,MUTUALDE",SLN,MEDICARE,MEDICAID,UPIN,DEA,NPI,MUTUALDE)
  1. D ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
  1. I FLNAME'="",FFNAME'="" D
  1. .D ONAME^PSOERXOU(GBL,.CNT,"FormerName",FLNAME,FFNAME,FMNAME,FSUFF,FPREF)
  1. D BL(GBL,.CNT,"BusinessName",BNAME)
  1. D:$L(ADDL1_ADDL2_CITY_STATE_ZIP_CNTRY) OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
  1. D OCOMM^PSOERXOU(GBL,SGBL8,.CNT,PHIENS,52.4811,52.48,12,PHIENS)
  1. D C S @GBL@(CNT,0)="</Pharmacist>"
  1. Q
  1. ;
  1. LOCAL(GBL,CNT,PSOSITE,PSOIEN) ;
  1. N ADDL1,ADDL2,CITY,STATE,ZIP,NCPDPID,NPIINST,NPI,BNAME,NAME,LN,FN,MN,PHONE,CNTRY
  1. S NPIINST=$$GET1^DIQ(59,PSOSITE,101,"I")
  1. S NPI=$$GET1^DIQ(4,NPIINST,41.99,"E")
  1. S NAME=$$GET1^DIQ(200,DUZ,.01,"E")
  1. S LN=$P(NAME,","),FN=$P($P(NAME,",",2)," "),MN=$P($P(NAME,",",2)," ",2)
  1. S BNAME=$$GET1^DIQ(59,PSOSITE,.01,"E")
  1. S NCPDPID=$$GET1^DIQ(59,PSOSITE,1008,"E")
  1. S ADDL1=$$GET1^DIQ(59,PSOSITE,.02,"E")
  1. S ADDL2=""
  1. S CITY=$$GET1^DIQ(59,PSOSITE,.07,"E")
  1. S STATE=$$GET1^DIQ(59,PSOSITE,.08,"I"),STATE=$$GET1^DIQ(5,STATE,1,"E")
  1. S ZIP=$E($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
  1. S PHONE=$$GET1^DIQ(59,PSOSITE,.04,"E")
  1. S PHONE=$TR(PHONE,")",""),PHONE=$TR(PHONE,"(",""),PHONE=$TR(PHONE,"-","")
  1. S CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
  1. ; default to US if country code could not be found (per PBM 10/27/2020).
  1. I CNTRY']"" S CNTRY="US"
  1. D C S @GBL@(CNT,0)="<Pharmacy>"
  1. D C S @GBL@(CNT,0)="<Identification>"
  1. D BL(GBL,.CNT,"NCPDPID",NCPDPID)
  1. D BL(GBL,.CNT,"NPI",NPI)
  1. D C S @GBL@(CNT,0)="</Identification>"
  1. ; PHARMACIST - LOCAL
  1. D C S @GBL@(CNT,0)="<Pharmacist>"
  1. I $L(LN_FN_MN) D
  1. .D C S @GBL@(CNT,0)="<Name>"
  1. .D BL(GBL,.CNT,"LastName",LN),BL(GBL,.CNT,"FirstName",FN)
  1. .I $L(MN) D BL(GBL,.CNT,"MiddleName",MN)
  1. .D C S @GBL@(CNT,0)="</Name>"
  1. D C S @GBL@(CNT,0)="</Pharmacist>"
  1. D BL(GBL,.CNT,"BusinessName",BNAME)
  1. I $L(ADDL1_ADDL2_CITY_STATE_ZIP) D
  1. .D C S @GBL@(CNT,0)="<Address>"
  1. .D BL(GBL,.CNT,"AddressLine1",ADDL1)
  1. .D BL(GBL,.CNT,"AddressLine2",ADDL2)
  1. .D BL(GBL,.CNT,"City",CITY)
  1. .D BL(GBL,.CNT,"StateProvince",STATE)
  1. .D BL(GBL,.CNT,"PostalCode",ZIP)
  1. .D BL(GBL,.CNT,"CountryCode",CNTRY)
  1. .D C S @GBL@(CNT,0)="</Address>"
  1. D C S @GBL@(CNT,0)="<CommunicationNumbers>"
  1. D C S @GBL@(CNT,0)="<PrimaryTelephone>"
  1. D BL(GBL,.CNT,"Number",$S($L(PHONE):PHONE,1:"0000000000"))
  1. D C S @GBL@(CNT,0)="</PrimaryTelephone>"
  1. D C S @GBL@(CNT,0)="</CommunicationNumbers>"
  1. D C S @GBL@(CNT,0)="</Pharmacy>"
  1. Q
  1. BL(GBL,CNT,TAG,VAR) ; Build line
  1. Q:VAR=""
  1. D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
  1. Q
  1. ;
  1. C ; Update counter
  1. S CNT=$G(CNT)+1
  1. Q
  1. ;
  1. OID(GBL,CNT,NAMES,SLN,MEDICARE,MEDICAID,UPIN,DEA,NPI,MUTUALDE,NCPDPID,HIN) ; Create Identification structure
  1. N I,NAME,VAL
  1. D C S @GBL@(CNT,0)="<Identification>"
  1. F I=1:1:$L(NAMES,"^") D
  1. .S NAME=$P($P(NAMES,"^",I),","),VAL=$P($P(NAMES,"^",I),",",2)
  1. .D BL(GBL,.CNT,NAME,@VAL)
  1. D C S @GBL@(CNT,0)="</Identification>"
  1. Q