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