PSOERXOD ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
;
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)
; address missing from NewRx
I $G(ADDL1)="" D
.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")
.I STATE S STATE=$$GET1^DIQ(5,STATE,1,"E")
.S ZIP=$E($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
.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>"
D C S @GBL@(CNT,0)="<CommunicationNumbers>"
D C S @GBL@(CNT,0)="<PrimaryTelephone>"
D BL(GBL,.CNT,"Number",$S($L(PHONE):PHONE,1:"0000000000"))
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOD 8135 printed Apr 09, 2024@21:26 Page 2
PSOERXOD ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581,651**;DEC 1997;Build 30
+2 ;
+3 QUIT
+4 ;
+5 ;/JSG/ POS*7.0*581 - BEGIN CHANGE
OPHARM(GBL,CNT,PSOSITE,PSOIEN) ; Adapted from VAPHARM^PSOERXX2
+1 NEW ADDL1,ADDL18,ADDL2,ADDL28,BNAME7,BNAME8,CITY,CITY8,CNTRY,CNTRY8
+2 NEW DEA7,DEA8,F,F2,FFNAME,FLNAME,FMNAME,FNAME,FPREF,FSUFF,HIN7,ID
+3 NEW IEN,IENS,LNAME,MEDICAI7,MEDICAI8,MEDICAR7,MEDICAR8,MNAME
+4 NEW MUTDEF7,MUTDEF8,NCPDPID7,NPI,NPI7,NPI8,PARAMS,PHARDAT,PHIEN,PHIENS
+5 NEW PHRMCIST,PREF,SGBL7,SGBL8,SPEC,STATE,STATE8,STLICNO7,STLICNO8,STNM
+6 NEW SUFF,TXT,UPIN7,UPIN8,ZIP,ZIP8,INST,CNTRYIEN
+7 SET F=52.47
SET F2=52.48
+8 SET IEN=$$GET1^DIQ(52.49,PSOIEN,2.5,"I")
+9 IF 'IEN
DO LOCAL(GBL,.CNT,PSOSITE,PSOIEN)
QUIT
+10 SET IENS=IEN_","
+11 DO GETS^DIQ(F,IENS,"**","IE","PHARDAT")
+12 SET PHIEN=$GET(PHARDAT(F,IENS,4,"I"))
+13 SET PHIENS=PHIEN_","
+14 DO GETS^DIQ(F2,PHIENS,"**","IE","PHRMCIST")
+15 DO CONVXML^PSOERXX1("PHARDAT")
DO CONVXML^PSOERXX1("PHRMCIST")
+16 SET LNAME=$GET(PHRMCIST(F2,PHIENS,.02,"E"))
+17 SET FNAME=$GET(PHRMCIST(F2,PHIENS,.03,"E"))
+18 SET MNAME=$GET(PHRMCIST(F2,PHIENS,.04,"E"))
+19 SET SUFF=$GET(PHRMCIST(F2,PHIENS,.05,"E"))
+20 SET PREF=$GET(PHRMCIST(F2,PHIENS,.06,"E"))
+21 SET NPI=$GET(PHRMCIST(F2,PHIENS,15.1,"E"))
+22 SET STNM=$GET(PHARDAT(F,IENS,.01,"E"))
+23 SET ADDL1=$GET(PHARDAT(F,IENS,1.1,"E"))
+24 SET ADDL2=$GET(PHARDAT(F,IENS,1.2,"E"))
+25 SET CITY=$GET(PHARDAT(F,IENS,1.3,"E"))
+26 SET STATE=$GET(PHARDAT(F,IENS,1.4,"I"))
+27 SET ZIP=$GET(PHARDAT(F,IENS,1.5,"E"))
SET ZIP=$TRANSLATE(ZIP,"-","")
+28 SET CNTRY=$GET(PHARDAT(F,IENS,1.7,"E"))
+29 ; country code is required on an rxRenewalRequest, try to get it from the Institution file
+30 IF CNTRY']""
SET CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
+31 ; address missing from NewRx
+32 IF $GET(ADDL1)=""
Begin DoDot:1
+33 SET ADDL1=$$GET1^DIQ(59,PSOSITE,.02,"E")
+34 SET ADDL2=""
+35 SET CITY=$$GET1^DIQ(59,PSOSITE,.07,"E")
+36 SET STATE=$$GET1^DIQ(59,PSOSITE,.08,"I")
+37 IF STATE
SET STATE=$$GET1^DIQ(5,STATE,1,"E")
+38 SET ZIP=$EXTRACT($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
+39 SET CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
End DoDot:1
+40 ; default to US if country code could not be found (per PBM 10/27/2020).
+41 IF CNTRY']""
SET CNTRY="US"
+42 ; VARIABLES ENDING IN 7 <-> File #52.47
+43 ; VARIABLES ENDING IN 7 <-> File #52.48
+44 SET SPEC=$GET(PHARDAT(F,IENS,1.8,"E"))
+45 SET NCPDPID7=$GET(PHARDAT(F,IENS,10.1,"E"))
+46 SET STLICNO7=$GET(PHARDAT(F,IENS,9.1,"E"))
+47 SET MEDICAR7=$GET(PHARDAT(F,IENS,9.2,"E"))
+48 SET MEDICAI7=$GET(PHARDAT(F,IENS,9.3,"E"))
+49 SET UPIN7=$GET(PHARDAT(F,IENS,9.4,"E"))
+50 SET DEA7=$GET(PHARDAT(F,IENS,10.3,"E"))
+51 SET HIN7=$GET(PHARDAT(F,IENS,9.5,"E"))
+52 SET NPI7=$GET(PHARDAT(F,IENS,10.2,"E"))
+53 SET MUTDEF7=$GET(PHARDAT(F,IENS,9.6,"E"))
+54 SET BNAME7=$GET(PHARDAT(F,IENS,.01,"E"))
if BNAME7=""
SET BNAME7=$GET(PHARDAT(F,IENS,.05,"E"))
+55 SET FLNAME=$GET(PHRMCIST(F2,PHIENS,2.4,"E"))
+56 SET FFNAME=$GET(PHRMCIST(F2,PHIENS,2.5,"E"))
+57 SET FMNAME=$GET(PHRMCIST(F2,PHIENS,2.6,"E"))
+58 SET FSUFF=$GET(PHRMCIST(F2,PHIENS,2.7,"E"))
+59 SET FPREF=$GET(PHRMCIST(F2,PHIENS,2.8,"E"))
+60 SET ADDL18=$GET(PHRMCIST(F2,PHIENS,4.1,"E"))
+61 SET ADDL28=$GET(PHRMCIST(F2,PHIENS,4.2,"E"))
+62 SET CITY8=$GET(PHRMCIST(F2,PHIENS,4.3,"E"))
+63 SET STATE8=$GET(PHRMCIST(F2,PHIENS,4.4,"I"))
+64 SET ZIP8=$GET(PHRMCIST(F2,PHIENS,4.5,"E"))
+65 SET CNTRY8=$GET(PHRMCIST(F2,PHIENS,2.2,"E"))
+66 SET BNAME8=$GET(PHRMCIST(F2,PHIENS,2.1,"E"))
+67 SET STLICNO8=$GET(PHRMCIST(F2,PHIENS,14.1,"E"))
+68 SET MEDICAR8=$GET(PHRMCIST(F2,PHIENS,14.2,"E"))
+69 SET MEDICAI8=$GET(PHRMCIST(F2,PHIENS,14.3,"E"))
+70 SET UPIN8=$GET(PHRMCIST(F2,PHIENS,14.4,"E"))
+71 SET DEA8=$GET(PHRMCIST(F2,PHIENS,14.5,"E"))
+72 SET NPI8=$GET(PHRMCIST(F2,PHIENS,15.1,"E"))
+73 SET MUTDEF8=$GET(PHRMCIST(F2,PHIENS,15.4,"E"))
+74 SET SGBL7=$NAME(^PS(52.47,IEN,7))
+75 SET SGBL8=$NAME(^PS(52.48,PHIEN,11))
+76 ;
+77 ; Create Pharmacy structure
+78 ;
+79 IF NCPDPID7'=""
IF NPI7'=""
IF BNAME7'=""
Begin DoDot:1
+80 DO C
SET @GBL@(CNT,0)="<Pharmacy>"
+81 ; Identification
Begin DoDot:2
+82 SET PARAMS="NCPDPID,NCPDPID7^StateLicenseNumber,STLICNO7"
+83 SET PARAMS=PARAMS_"^MedicareNumber,MEDICAR7^MedicaidNumber,MEDICAI7"
+84 SET PARAMS=PARAMS_"^UPIN,UPIN7^DEANumber,DEA7^HIN,HIN7"
+85 SET PARAMS=PARAMS_"^NPI,NPI7^MutuallyDefined,MUTDEF7"
+86 DO OID(GBL,.CNT,PARAMS,STLICNO7,MEDICAR7,MEDICAI7,UPIN7,DEA7,NPI7,MUTDEF7,NCPDPID7,HIN7)
End DoDot:2
+87 DO BL(GBL,.CNT,"Specialty",SPEC)
+88 IF LNAME'=""
IF FNAME'=""
Begin DoDot:2
+89 DO 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)
End DoDot:2
+90 DO C
SET @GBL@(CNT,0)="<BusinessName>"_BNAME7_"</BusinessName>"
+91 ; Address
if $LENGTH(ADDL1_ADDL2_CITY_STATE_ZIP_CNTRY)
Begin DoDot:2
+92 DO OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
End DoDot:2
+93 DO OCOMM^PSOERXOU(GBL,SGBL7,.CNT,IENS,52.477,52.47,8,IENS)
+94 DO C
SET @GBL@(CNT,0)="</Pharmacy>"
End DoDot:1
+95 QUIT
+96 ;
OPHARMD ;;
+1 ;;NCPDPID7;STLICNO7;MEDICAR7;MEDICAI7;UPIN7;DEA7;HIN7;NPI7;MUTDEF7
+2 ;;SPEC;STLICNO8;MEDICAR8;MEDICAI8;UPIN8;DEA8;NPI8;MUTDEF8;BNAME7
+3 ;;ADDL1;ADDL2;CITY;STATE;ZIP;CNTRY
+4 ;;***END***
+5 ;/JSG/ - END CHANGE
+6 ;
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 NEW SUBFILE
+2 DO C
SET @GBL@(CNT,0)="<Pharmacist>"
+3 ;Identification
+4 IF $LENGTH(SLN_MEDICARE_MEDICAID_UPIN_DEA_NPI_MUTUALDE)
Begin DoDot:1
+5 DO OID(GBL,.CNT,"StateLicenseNumber,SLN^MedicareNumber,MEDICARE^MedicaidNumber,MEDICAID^UPIN,UPIN^DEANumber,DEA^NPI,NPI^MutuallyDefined,MUTUALDE",SLN,MEDICARE,MEDICAID,UPIN,DEA,NPI,MUTUALDE)
End DoDot:1
+6 DO ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
+7 IF FLNAME'=""
IF FFNAME'=""
Begin DoDot:1
+8 DO ONAME^PSOERXOU(GBL,.CNT,"FormerName",FLNAME,FFNAME,FMNAME,FSUFF,FPREF)
End DoDot:1
+9 DO BL(GBL,.CNT,"BusinessName",BNAME)
+10 if $LENGTH(ADDL1_ADDL2_CITY_STATE_ZIP_CNTRY)
DO OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
+11 DO OCOMM^PSOERXOU(GBL,SGBL8,.CNT,PHIENS,52.4811,52.48,12,PHIENS)
+12 DO C
SET @GBL@(CNT,0)="</Pharmacist>"
+13 QUIT
+14 ;
LOCAL(GBL,CNT,PSOSITE,PSOIEN) ;
+1 NEW ADDL1,ADDL2,CITY,STATE,ZIP,NCPDPID,NPIINST,NPI,BNAME,NAME,LN,FN,MN,PHONE,CNTRY
+2 SET NPIINST=$$GET1^DIQ(59,PSOSITE,101,"I")
+3 SET NPI=$$GET1^DIQ(4,NPIINST,41.99,"E")
+4 SET NAME=$$GET1^DIQ(200,DUZ,.01,"E")
+5 SET LN=$PIECE(NAME,",")
SET FN=$PIECE($PIECE(NAME,",",2)," ")
SET MN=$PIECE($PIECE(NAME,",",2)," ",2)
+6 SET BNAME=$$GET1^DIQ(59,PSOSITE,.01,"E")
+7 SET NCPDPID=$$GET1^DIQ(59,PSOSITE,1008,"E")
+8 SET ADDL1=$$GET1^DIQ(59,PSOSITE,.02,"E")
+9 SET ADDL2=""
+10 SET CITY=$$GET1^DIQ(59,PSOSITE,.07,"E")
+11 SET STATE=$$GET1^DIQ(59,PSOSITE,.08,"I")
SET STATE=$$GET1^DIQ(5,STATE,1,"E")
+12 SET ZIP=$EXTRACT($$GET1^DIQ(59,PSOSITE,.05,"E"),1,5)
+13 SET PHONE=$$GET1^DIQ(59,PSOSITE,.04,"E")
+14 SET PHONE=$TRANSLATE(PHONE,")","")
SET PHONE=$TRANSLATE(PHONE,"(","")
SET PHONE=$TRANSLATE(PHONE,"-","")
+15 SET CNTRY=$$INSCCODE^PSOERXOU(PSOSITE)
+16 ; default to US if country code could not be found (per PBM 10/27/2020).
+17 IF CNTRY']""
SET CNTRY="US"
+18 DO C
SET @GBL@(CNT,0)="<Pharmacy>"
+19 DO C
SET @GBL@(CNT,0)="<Identification>"
+20 DO BL(GBL,.CNT,"NCPDPID",NCPDPID)
+21 DO BL(GBL,.CNT,"NPI",NPI)
+22 DO C
SET @GBL@(CNT,0)="</Identification>"
+23 ; PHARMACIST - LOCAL
+24 DO C
SET @GBL@(CNT,0)="<Pharmacist>"
+25 IF $LENGTH(LN_FN_MN)
Begin DoDot:1
+26 DO C
SET @GBL@(CNT,0)="<Name>"
+27 DO BL(GBL,.CNT,"LastName",LN)
DO BL(GBL,.CNT,"FirstName",FN)
+28 IF $LENGTH(MN)
DO BL(GBL,.CNT,"MiddleName",MN)
+29 DO C
SET @GBL@(CNT,0)="</Name>"
End DoDot:1
+30 DO C
SET @GBL@(CNT,0)="</Pharmacist>"
+31 DO BL(GBL,.CNT,"BusinessName",BNAME)
+32 IF $LENGTH(ADDL1_ADDL2_CITY_STATE_ZIP)
Begin DoDot:1
+33 DO C
SET @GBL@(CNT,0)="<Address>"
+34 DO BL(GBL,.CNT,"AddressLine1",ADDL1)
+35 DO BL(GBL,.CNT,"AddressLine2",ADDL2)
+36 DO BL(GBL,.CNT,"City",CITY)
+37 DO BL(GBL,.CNT,"StateProvince",STATE)
+38 DO BL(GBL,.CNT,"PostalCode",ZIP)
+39 DO BL(GBL,.CNT,"CountryCode",CNTRY)
+40 DO C
SET @GBL@(CNT,0)="</Address>"
End DoDot:1
+41 DO C
SET @GBL@(CNT,0)="<CommunicationNumbers>"
+42 DO C
SET @GBL@(CNT,0)="<PrimaryTelephone>"
+43 DO BL(GBL,.CNT,"Number",$SELECT($LENGTH(PHONE):PHONE,1:"0000000000"))
+44 DO C
SET @GBL@(CNT,0)="</PrimaryTelephone>"
+45 DO C
SET @GBL@(CNT,0)="</CommunicationNumbers>"
+46 DO C
SET @GBL@(CNT,0)="</Pharmacy>"
+47 QUIT
BL(GBL,CNT,TAG,VAR) ; Build line
+1 if VAR=""
QUIT
+2 DO C
SET @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
+3 QUIT
+4 ;
C ; Update counter
+1 SET CNT=$GET(CNT)+1
+2 QUIT
+3 ;
OID(GBL,CNT,NAMES,SLN,MEDICARE,MEDICAID,UPIN,DEA,NPI,MUTUALDE,NCPDPID,HIN) ; Create Identification structure
+1 NEW I,NAME,VAL
+2 DO C
SET @GBL@(CNT,0)="<Identification>"
+3 FOR I=1:1:$LENGTH(NAMES,"^")
Begin DoDot:1
+4 SET NAME=$PIECE($PIECE(NAMES,"^",I),",")
SET VAL=$PIECE($PIECE(NAMES,"^",I),",",2)
+5 DO BL(GBL,.CNT,NAME,@VAL)
End DoDot:1
+6 DO C
SET @GBL@(CNT,0)="</Identification>"
+7 QUIT
