- PSOERXOE ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
- ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
- ;
- Q
- ;
- ; GBL - GLOBAL WHERE DATA IS STORED
- ; IEN - IEN TO 52.49
- ; PTYPE - person type (P-Pharmacist, PR - Prescriber, S - Supervisor, FU - FollowUp Prescriber
- PERSON(GBL,CNT,PSOSITE,IEN,PTYPE) ;
- N F,DEAN,NPI,SPEC,CLINIC,LNAME,FNAME,MNAME,SUFF,PREF,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY,ALNAME,AFNAME,AMNAME,ASUFF,APREF
- N PSDAT,CLOOP,CNUM,CQUAL,ILOOP,ITYP,IVAL,PIEN,PIENS,VNV,BNAME,CERT2P,DATA2000,DEA,FAFNAME
- N FALNAME,FAMNAME,FAPREF,FASUFF,FFN,FLN,FMN,FNAME,FPRE,FSUF,HIN,IENS,MCAID,MCARE,MDEF,PTAG
- N PDEA,PFID,PHIN,PMCAID,PMCARE,PMDEF,PNCPDP,PNPI,PPOS,PREMS,PSTLN,PUPIN,REMS,SGBL,SSN,STATECS
- N STATCS,STLN,UPIN
- S F=52.48,IENS=IEN_","
- I PTYPE="P" S PIEN=$$GET1^DIQ(52.49,IEN,2.2,"I")
- I PTYPE="PR" S PIEN=$$GET1^DIQ(52.49,IEN,2.1,"I")
- I PTYPE="S" S PIEN=$$GET1^DIQ(52.49,IEN,2.6,"I")
- I PTYPE="FU" S PIEN=$$GET1^DIQ(52.49,IEN,307.1,"I")
- Q:'PIEN
- S PIENS=PIEN_","
- D GETS^DIQ(F,PIENS,"**","IE","PSDAT")
- D CONVXML^PSOERXX1("PSDAT")
- S DEAN=$G(PSDAT(F,PIENS,1.6,"E"))
- S NPI=$G(PSDAT(F,PIENS,1.5,"E"))
- S PTAG=$S(PTYPE="P":"Pharmacist",PTYPE="PR":"Prescriber",PTYPE="S":"Supervisor",PTYPE="FP":"FolloupPrescriber",1:"")
- Q:PTAG=""
- S SPEC=$G(PSDAT(F,PIENS,1.2,"E"))
- S CLINIC=$G(PSDAT(F,PIENS,2.1,"E"))
- S ADDL1=$G(PSDAT(F,PIENS,4.1,"E"))
- S ADDL2=$G(PSDAT(F,PIENS,4.2,"E"))
- S CITY=$G(PSDAT(F,PIENS,4.3,"E"))
- S STATE=$G(PSDAT(F,PIENS,4.4,"I"))
- S ZIP=$G(PSDAT(F,PIENS,4.5,"E"))
- S CNTRY=$G(PSDAT(F,PIENS,2.2,"E"))
- S VNV=$G(PSDAT(F,PIENS,19.1,"I")),VNV=$S(VNV:"Veterinarian",1:"NonVeterinarian")
- D C S @GBL@(CNT,0)="<"_PTAG_">"
- D C S @GBL@(CNT,0)="<"_VNV_">"
- ; identification
- S STLN=$G(PSDAT(F,PIENS,14.1,"E")),MCARE=$G(PSDAT(F,PIENS,14.2,"E")),MCAID=$G(PSDAT(F,PIENS,14.3,"E")),UPIN=$G(PSDAT(F,PIENS,14.4,"E"))
- S DEA=$G(PSDAT(F,PIENS,14.5,"E")),HIN=$G(PSDAT(F,PIENS,14.6,"E")),SSN=$G(PSDAT(F,PIENS,14.7,"E"))
- S NPI=$G(PSDAT(F,PIENS,15.1,"E")),CERT2P=$G(PSDAT(F,PIENS,15.2,"E")),DATA2000=$G(PSDAT(F,PIENS,15.3,"E"))
- S MDEF=$G(PSDAT(F,PIENS,15.4,"E")),REMS=$G(PSDAT(F,PIENS,15.5,"E")),STATECS=$G(PSDAT(F,PIENS,15.6,"E"))
- D C S @GBL@(CNT,0)="<Identification>"
- D BL(GBL,.CNT,"StateLicenseNumber",STLN),BL(GBL,.CNT,"MedicareNumber",MCARE),BL(GBL,.CNT,"MedicaidNumber",MCAID)
- D BL(GBL,.CNT,"UPIN",UPIN),BL(GBL,.CNT,"DEANumber",DEA),BL(GBL,.CNT,"HIN",HIN)
- D BL(GBL,.CNT,"SocialSecurityNumber",SSN),BL(GBL,.CNT,"NPI",NPI),BL(GBL,.CNT,"CertificateToPrescribe",CERT2P)
- D BL(GBL,.CNT,"Data2000WaiverID",DATA2000),BL(GBL,.CNT,"MutuallyDefined",MDEF),BL(GBL,.CNT,"REMSHealthcareProviderEnrollmentID",REMS)
- D BL(GBL,.CNT,"StateControlSubstanceNumber",STATECS)
- D C S @GBL@(CNT,0)="</Identification>"
- I $L(SPEC) D C S @GBL@(CNT,0)="<Specialty>"_SPEC_"</Specialty>"
- ; Practice location fields
- S PNCPDP=$G(PSDAT(F,PIENS,17.1,"E")),PSTLN=$G(PSDAT(F,PIENS,17.2,"E")),PMCARE=$G(PSDAT(F,PIENS,17.3,"E")),PMCAID=$G(PSDAT(F,PIENS,17.4,"E"))
- S PUPIN=$G(PSDAT(F,PIENS,17.5,"E")),PFID=$G(PSDAT(F,PIENS,17.6,"E"))
- S PDEA=$G(PSDAT(F,PIENS,18.1,"E")),PHIN=$G(PSDAT(F,PIENS,18.2,"E")),PNPI=$G(PSDAT(F,PIENS,18.3,"E")),PMDEF=$G(PSDAT(F,PIENS,18.4,"E"))
- S PREMS=$G(PSDAT(F,PIENS,18.5,"E"))
- S BNAME=$G(PSDAT(F,PIENS,18.6,"E"))
- ; practice location segment
- D C S @GBL@(CNT,0)="<PracticeLocation>"
- D C S @GBL@(CNT,0)="<Identification>"
- D BL(GBL,.CNT,"NCPDPID",PNCPDP),BL(GBL,.CNT,"StateLicenseNumber",PSTLN),BL(GBL,.CNT,"MedicareNumber",PMCARE),BL(GBL,.CNT,"MedicaidNumber",PMCAID)
- D BL(GBL,.CNT,"UPIN",PUPIN),BL(GBL,.CNT,"FacilityID",PFID),BL(GBL,.CNT,"DEANumber",PDEA),BL(GBL,.CNT,"HIN",PHIN)
- D BL(GBL,.CNT,"NPI",PNPI),BL(GBL,.CNT,"MutuallyDefined",PMDEF),BL(GBL,.CNT,"REMSHealthcareSettingEnrollmentID",PREMS)
- D C S @GBL@(CNT,0)="</Identification>"
- D BL(GBL,.CNT,"BusinessName",BNAME)
- D C S @GBL@(CNT,0)="</PracticeLocation>"
- ; name
- S LNAME=$G(PSDAT(F,PIENS,.02,"E")),FNAME=$G(PSDAT(F,PIENS,.03,"E")),MNAME=$G(PSDAT(F,PIENS,.04,"E"))
- S SUFF=$G(PSDAT(F,PIENS,.05,"E")),PREF=$G(PSDAT(F,PIENS,.06,"E"))
- D ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
- ; former name
- S FLN=$G(PSDAT(F,PIENS,2.4,"E")),FFN=$G(PSDAT(F,PIENS,2.5,"E")),FMN=$G(PSDAT(F,PIENS,2.6,"E"))
- S FSUF=$G(PSDAT(F,PIENS,2.7,"E")),FPRE=$G(PSDAT(F,PIENS,2.8,"E"))
- D ONAME^PSOERXOU(GBL,.CNT,"FormerName",FLN,FFN,FMN,FSUF,FPRE)
- D OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
- ; agent name
- S ALNAME=$G(PSDAT(F,PIENS,5.1,"E")),AFNAME=$G(PSDAT(F,PIENS,5.2,"E")),AMNAME=$G(PSDAT(F,PIENS,5.3,"E"))
- S ASUFF=$G(PSDAT(F,PIENS,5.4,"E")),APREF=$G(PSDAT(F,PIENS,5.5,"E"))
- ; agent former name
- S FALNAME=$G(PSDAT(F,PIENS,5.1,"E")),FAFNAME=$G(PSDAT(F,PIENS,5.2,"E")),FAMNAME=$G(PSDAT(F,PIENS,5.3,"E"))
- S FASUFF=$G(PSDAT(F,PIENS,5.4,"E")),FAPREF=$G(PSDAT(F,PIENS,5.5,"E"))
- I $L(ALNAME) D
- .D C S @GBL@(CNT,0)="<PresriberAgent>"
- .D ONAME^PSOERXOU(GBL,.CNT,"Name",ALNAME,AFNAME,AMNAME,ASUFF,APREF)
- .I $L(FALNAME) D ONAME^PSOERXOU(GBL,.CNT,"FormerName",FALNAME,FAFNAME,FAMNAME,FASUFF,FAPREF)
- .D C S @GBL@(CNT,0)="</PresriberAgent>"
- S SGBL=$NA(^PS(52.48,PIEN,11))
- D OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIENS,52.4811,52.48,12,PIENS)
- ; prescriber Place of service
- S PPOS=$G(PSDAT(F,PIENS,2.3,"E"))
- D BL(GBL,.CNT,"PrescriberPlaceOfService",PPOS)
- D C S @GBL@(CNT,0)="</"_VNV_">"
- D C S @GBL@(CNT,0)="</"_PTAG_">"
- Q
- ; GBL - GLOBAL WHERE DATA IS STORED
- ; IEN - IEN TO 52.49
- PRORENRQ(GBL,CNT,IEN) ; Set up Prohibit Renewal Request
- N F,PROHIBIT
- S F=52.49
- S PROHIBIT=$$GET1^DIQ(52.49,IEN,301.3,"I")
- D BL(GBL,.CNT,"ProhibitRenewalRequest",PROHIBIT)
- Q
- ;
- BL(GBL,CNT,TAG,VAR) ;
- Q:VAR=""
- D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
- Q
- C ;
- S CNT=$G(CNT)+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOE 5793 printed Feb 18, 2025@23:55:16 Page 2
- PSOERXOE ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
- +2 ;
- +3 QUIT
- +4 ;
- +5 ; GBL - GLOBAL WHERE DATA IS STORED
- +6 ; IEN - IEN TO 52.49
- +7 ; PTYPE - person type (P-Pharmacist, PR - Prescriber, S - Supervisor, FU - FollowUp Prescriber
- PERSON(GBL,CNT,PSOSITE,IEN,PTYPE) ;
- +1 NEW F,DEAN,NPI,SPEC,CLINIC,LNAME,FNAME,MNAME,SUFF,PREF,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY,ALNAME,AFNAME,AMNAME,ASUFF,APREF
- +2 NEW PSDAT,CLOOP,CNUM,CQUAL,ILOOP,ITYP,IVAL,PIEN,PIENS,VNV,BNAME,CERT2P,DATA2000,DEA,FAFNAME
- +3 NEW FALNAME,FAMNAME,FAPREF,FASUFF,FFN,FLN,FMN,FNAME,FPRE,FSUF,HIN,IENS,MCAID,MCARE,MDEF,PTAG
- +4 NEW PDEA,PFID,PHIN,PMCAID,PMCARE,PMDEF,PNCPDP,PNPI,PPOS,PREMS,PSTLN,PUPIN,REMS,SGBL,SSN,STATECS
- +5 NEW STATCS,STLN,UPIN
- +6 SET F=52.48
- SET IENS=IEN_","
- +7 IF PTYPE="P"
- SET PIEN=$$GET1^DIQ(52.49,IEN,2.2,"I")
- +8 IF PTYPE="PR"
- SET PIEN=$$GET1^DIQ(52.49,IEN,2.1,"I")
- +9 IF PTYPE="S"
- SET PIEN=$$GET1^DIQ(52.49,IEN,2.6,"I")
- +10 IF PTYPE="FU"
- SET PIEN=$$GET1^DIQ(52.49,IEN,307.1,"I")
- +11 if 'PIEN
- QUIT
- +12 SET PIENS=PIEN_","
- +13 DO GETS^DIQ(F,PIENS,"**","IE","PSDAT")
- +14 DO CONVXML^PSOERXX1("PSDAT")
- +15 SET DEAN=$GET(PSDAT(F,PIENS,1.6,"E"))
- +16 SET NPI=$GET(PSDAT(F,PIENS,1.5,"E"))
- +17 SET PTAG=$SELECT(PTYPE="P":"Pharmacist",PTYPE="PR":"Prescriber",PTYPE="S":"Supervisor",PTYPE="FP":"FolloupPrescriber",1:"")
- +18 if PTAG=""
- QUIT
- +19 SET SPEC=$GET(PSDAT(F,PIENS,1.2,"E"))
- +20 SET CLINIC=$GET(PSDAT(F,PIENS,2.1,"E"))
- +21 SET ADDL1=$GET(PSDAT(F,PIENS,4.1,"E"))
- +22 SET ADDL2=$GET(PSDAT(F,PIENS,4.2,"E"))
- +23 SET CITY=$GET(PSDAT(F,PIENS,4.3,"E"))
- +24 SET STATE=$GET(PSDAT(F,PIENS,4.4,"I"))
- +25 SET ZIP=$GET(PSDAT(F,PIENS,4.5,"E"))
- +26 SET CNTRY=$GET(PSDAT(F,PIENS,2.2,"E"))
- +27 SET VNV=$GET(PSDAT(F,PIENS,19.1,"I"))
- SET VNV=$SELECT(VNV:"Veterinarian",1:"NonVeterinarian")
- +28 DO C
- SET @GBL@(CNT,0)="<"_PTAG_">"
- +29 DO C
- SET @GBL@(CNT,0)="<"_VNV_">"
- +30 ; identification
- +31 SET STLN=$GET(PSDAT(F,PIENS,14.1,"E"))
- SET MCARE=$GET(PSDAT(F,PIENS,14.2,"E"))
- SET MCAID=$GET(PSDAT(F,PIENS,14.3,"E"))
- SET UPIN=$GET(PSDAT(F,PIENS,14.4,"E"))
- +32 SET DEA=$GET(PSDAT(F,PIENS,14.5,"E"))
- SET HIN=$GET(PSDAT(F,PIENS,14.6,"E"))
- SET SSN=$GET(PSDAT(F,PIENS,14.7,"E"))
- +33 SET NPI=$GET(PSDAT(F,PIENS,15.1,"E"))
- SET CERT2P=$GET(PSDAT(F,PIENS,15.2,"E"))
- SET DATA2000=$GET(PSDAT(F,PIENS,15.3,"E"))
- +34 SET MDEF=$GET(PSDAT(F,PIENS,15.4,"E"))
- SET REMS=$GET(PSDAT(F,PIENS,15.5,"E"))
- SET STATECS=$GET(PSDAT(F,PIENS,15.6,"E"))
- +35 DO C
- SET @GBL@(CNT,0)="<Identification>"
- +36 DO BL(GBL,.CNT,"StateLicenseNumber",STLN)
- DO BL(GBL,.CNT,"MedicareNumber",MCARE)
- DO BL(GBL,.CNT,"MedicaidNumber",MCAID)
- +37 DO BL(GBL,.CNT,"UPIN",UPIN)
- DO BL(GBL,.CNT,"DEANumber",DEA)
- DO BL(GBL,.CNT,"HIN",HIN)
- +38 DO BL(GBL,.CNT,"SocialSecurityNumber",SSN)
- DO BL(GBL,.CNT,"NPI",NPI)
- DO BL(GBL,.CNT,"CertificateToPrescribe",CERT2P)
- +39 DO BL(GBL,.CNT,"Data2000WaiverID",DATA2000)
- DO BL(GBL,.CNT,"MutuallyDefined",MDEF)
- DO BL(GBL,.CNT,"REMSHealthcareProviderEnrollmentID",REMS)
- +40 DO BL(GBL,.CNT,"StateControlSubstanceNumber",STATECS)
- +41 DO C
- SET @GBL@(CNT,0)="</Identification>"
- +42 IF $LENGTH(SPEC)
- DO C
- SET @GBL@(CNT,0)="<Specialty>"_SPEC_"</Specialty>"
- +43 ; Practice location fields
- +44 SET PNCPDP=$GET(PSDAT(F,PIENS,17.1,"E"))
- SET PSTLN=$GET(PSDAT(F,PIENS,17.2,"E"))
- SET PMCARE=$GET(PSDAT(F,PIENS,17.3,"E"))
- SET PMCAID=$GET(PSDAT(F,PIENS,17.4,"E"))
- +45 SET PUPIN=$GET(PSDAT(F,PIENS,17.5,"E"))
- SET PFID=$GET(PSDAT(F,PIENS,17.6,"E"))
- +46 SET PDEA=$GET(PSDAT(F,PIENS,18.1,"E"))
- SET PHIN=$GET(PSDAT(F,PIENS,18.2,"E"))
- SET PNPI=$GET(PSDAT(F,PIENS,18.3,"E"))
- SET PMDEF=$GET(PSDAT(F,PIENS,18.4,"E"))
- +47 SET PREMS=$GET(PSDAT(F,PIENS,18.5,"E"))
- +48 SET BNAME=$GET(PSDAT(F,PIENS,18.6,"E"))
- +49 ; practice location segment
- +50 DO C
- SET @GBL@(CNT,0)="<PracticeLocation>"
- +51 DO C
- SET @GBL@(CNT,0)="<Identification>"
- +52 DO BL(GBL,.CNT,"NCPDPID",PNCPDP)
- DO BL(GBL,.CNT,"StateLicenseNumber",PSTLN)
- DO BL(GBL,.CNT,"MedicareNumber",PMCARE)
- DO BL(GBL,.CNT,"MedicaidNumber",PMCAID)
- +53 DO BL(GBL,.CNT,"UPIN",PUPIN)
- DO BL(GBL,.CNT,"FacilityID",PFID)
- DO BL(GBL,.CNT,"DEANumber",PDEA)
- DO BL(GBL,.CNT,"HIN",PHIN)
- +54 DO BL(GBL,.CNT,"NPI",PNPI)
- DO BL(GBL,.CNT,"MutuallyDefined",PMDEF)
- DO BL(GBL,.CNT,"REMSHealthcareSettingEnrollmentID",PREMS)
- +55 DO C
- SET @GBL@(CNT,0)="</Identification>"
- +56 DO BL(GBL,.CNT,"BusinessName",BNAME)
- +57 DO C
- SET @GBL@(CNT,0)="</PracticeLocation>"
- +58 ; name
- +59 SET LNAME=$GET(PSDAT(F,PIENS,.02,"E"))
- SET FNAME=$GET(PSDAT(F,PIENS,.03,"E"))
- SET MNAME=$GET(PSDAT(F,PIENS,.04,"E"))
- +60 SET SUFF=$GET(PSDAT(F,PIENS,.05,"E"))
- SET PREF=$GET(PSDAT(F,PIENS,.06,"E"))
- +61 DO ONAME^PSOERXOU(GBL,.CNT,"Name",LNAME,FNAME,MNAME,SUFF,PREF)
- +62 ; former name
- +63 SET FLN=$GET(PSDAT(F,PIENS,2.4,"E"))
- SET FFN=$GET(PSDAT(F,PIENS,2.5,"E"))
- SET FMN=$GET(PSDAT(F,PIENS,2.6,"E"))
- +64 SET FSUF=$GET(PSDAT(F,PIENS,2.7,"E"))
- SET FPRE=$GET(PSDAT(F,PIENS,2.8,"E"))
- +65 DO ONAME^PSOERXOU(GBL,.CNT,"FormerName",FLN,FFN,FMN,FSUF,FPRE)
- +66 DO OADD^PSOERXOU(GBL,.CNT,ADDL1,ADDL2,CITY,STATE,ZIP,CNTRY)
- +67 ; agent name
- +68 SET ALNAME=$GET(PSDAT(F,PIENS,5.1,"E"))
- SET AFNAME=$GET(PSDAT(F,PIENS,5.2,"E"))
- SET AMNAME=$GET(PSDAT(F,PIENS,5.3,"E"))
- +69 SET ASUFF=$GET(PSDAT(F,PIENS,5.4,"E"))
- SET APREF=$GET(PSDAT(F,PIENS,5.5,"E"))
- +70 ; agent former name
- +71 SET FALNAME=$GET(PSDAT(F,PIENS,5.1,"E"))
- SET FAFNAME=$GET(PSDAT(F,PIENS,5.2,"E"))
- SET FAMNAME=$GET(PSDAT(F,PIENS,5.3,"E"))
- +72 SET FASUFF=$GET(PSDAT(F,PIENS,5.4,"E"))
- SET FAPREF=$GET(PSDAT(F,PIENS,5.5,"E"))
- +73 IF $LENGTH(ALNAME)
- Begin DoDot:1
- +74 DO C
- SET @GBL@(CNT,0)="<PresriberAgent>"
- +75 DO ONAME^PSOERXOU(GBL,.CNT,"Name",ALNAME,AFNAME,AMNAME,ASUFF,APREF)
- +76 IF $LENGTH(FALNAME)
- DO ONAME^PSOERXOU(GBL,.CNT,"FormerName",FALNAME,FAFNAME,FAMNAME,FASUFF,FAPREF)
- +77 DO C
- SET @GBL@(CNT,0)="</PresriberAgent>"
- End DoDot:1
- +78 SET SGBL=$NAME(^PS(52.48,PIEN,11))
- +79 DO OCOMM^PSOERXOU(GBL,SGBL,.CNT,PIENS,52.4811,52.48,12,PIENS)
- +80 ; prescriber Place of service
- +81 SET PPOS=$GET(PSDAT(F,PIENS,2.3,"E"))
- +82 DO BL(GBL,.CNT,"PrescriberPlaceOfService",PPOS)
- +83 DO C
- SET @GBL@(CNT,0)="</"_VNV_">"
- +84 DO C
- SET @GBL@(CNT,0)="</"_PTAG_">"
- +85 QUIT
- +86 ; GBL - GLOBAL WHERE DATA IS STORED
- +87 ; IEN - IEN TO 52.49
- PRORENRQ(GBL,CNT,IEN) ; Set up Prohibit Renewal Request
- +1 NEW F,PROHIBIT
- +2 SET F=52.49
- +3 SET PROHIBIT=$$GET1^DIQ(52.49,IEN,301.3,"I")
- +4 DO BL(GBL,.CNT,"ProhibitRenewalRequest",PROHIBIT)
- +5 QUIT
- +6 ;
- BL(GBL,CNT,TAG,VAR) ;
- +1 if VAR=""
- QUIT
- +2 DO C
- SET @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"
- +3 QUIT
- C ;
- +1 SET CNT=$GET(CNT)+1
- +2 QUIT
