- 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 Feb 18, 2025@23:55:15 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