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 Dec 13, 2024@02:28:50 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
