Routine: PSOERXOH

PSOERXOH ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm

 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126

ODIAG(GL,CNT,ERXIEN,MIEN) ; outbound diagnosis segment (52.493113)

 N F,DIAGIEN,DIAGDAT,DIAGIENS,CIQ,PDXCODE,PDXQUAL,PDXOV

 N PDXDESC,PDCOV,SDXCODE,SDXQUAL,SDXDESC,SDXOV

 S F=52.493113

 I '$O(^PS(52.49,ERXIEN,311,MIEN,3,0)) Q

 S DIAGIEN=0 F  S DIAGIEN=$O(^PS(52.49,ERXIEN,311,MIEN,3,DIAGIEN)) Q:'DIAGIEN  D

 .K DIAGDAT

 .S DIAGIENS=DIAGIEN_","_MIEN_","_ERXIEN_","

 .D GETS^DIQ(F,DIAGIENS,"**","IE","DIAGDAT")

 .S CIQ=$G(DIAGDAT(F,DIAGIENS,.02,"I")),PDXCODE=$G(DIAGDAT(F,DIAGIENS,1.1,"E")),PDXQUAL=$G(DIAGDAT(F,DIAGIENS,1.2,"I"))

 .S PDXOV=$G(DIAGDAT(F,DIAGIENS,1.3,"I")),PDXDESC=$G(DIAGDAT(F,DIAGIENS,2,"E")),SDXCODE=$G(DIAGDAT(F,DIAGIENS,3.1,"E"))

 .S SDXQUAL=$G(DIAGDAT(F,DIAGIENS,3.2,"I")),SDXOV=$G(DIAGDAT(F,DIAGIENS,3.3,"I")),SDXDESC=$G(DIAGDAT(F,DIAGIENS,4,"E"))

 .I $G(PDXOV) S PDXOV=$P($$EXTIME^PSOERXO1(PDXOV),"T")

 .I $G(SDXOV) S SDXOV=$P($$EXTIME^PSOERXO1(SDXOV),"T")

 .D C S @GBL@(CNT,0)="<Diagnosis>"

 .D BL(GBL,.CNT,"ClinicalInformationQualifier",CIQ)

 .I $L(PDXCODE_PDXQUAL_PDXDESC_PDXOV) D

 ..D C S @GBL@(CNT,0)="<Primary>"

 ..D BL(GBL,.CNT,"Code",PDXCODE)

 ..D BL(GBL,.CNT,"Qualifier",PDXQUAL)

 ..D BL(GBL,.CNT,"Description",PDXDESC)

 .I $L(PDXOV) D

 ..D C S @GBL@(CNT,0)="<DateOfLastOfficeVisit>"

 ..D BL(GBL,.CNT,"Date",PDXOV)

 ..D C S @GBL@(CNT,0)="</DateOfLastOfficeVisit>"

 .I $L(PDXCODE_PDXQUAL_PDXDESC_PDXOV) D

 ..D C S @GBL@(CNT,0)="</Primary>"

 .I $L(SDXCODE_SDXQUAL_SDXDESC_SDXOV) D

 ..D C S @GBL@(CNT,0)="<Secondary>"

 ..D BL(GBL,.CNT,"Code",SDXCODE)

 ..D BL(GBL,.CNT,"Qualifier",SDXQUAL)

 ..D BL(GBL,.CNT,"Description",SDXDESC)

 .I $L(SDXOV) D

 ..D C S @GBL@(CNT,0)="<DateOfLastOfficeVisit>"

 ..D BL(GBL,.CNT,"Date",SDXOV) ; need to write function to convert this date

 ..D C S @GBL@(CNT,0)="</DateOfLastOfficeVisit>"

 .I $L(SDXCODE_SDXQUAL_SDXDESC_SDXOV) D

 ..D C S @GBL@(CNT,0)="</Secondary>"

 .D C S @GBL@(CNT,0)="</Diagnosis>"

ODUE(GL,CNT,ERXIEN,MIEN) ;outbound drug use evaluation segment

 N F,DUEIEN,DUEDAT,DUEIENS,SERVREA,PROFSERV,SVXRC

 N CAC,CAQ,COAGDESC,CLINCODE,ACKREA

 S F=52.493116

 I '$O(^PS(52.49,ERXIEN,311,MIEN,6,0)) Q

 S DUEIEN=0 F  S DUEIEN=$O(^PS(52.49,ERXIEN,311,MIEN,6,DUEIEN)) Q:'DUEIEN  D

 .K DUEDAT

 .S DUEIENS=DUEIEN_","_MIEN_","_ERXIEN_","

 .D GETS^DIQ(F,DUEIENS,"**","IE","DUEDAT")

 .S SERVREA=$G(DUEDAT(F,DUEIENS,.02,"E")),PROFSERV=$G(DUEDAT(F,DUEIENS,.03,"E"))

 .S SVXRC=$G(DUEDAT(F,DUEIENS,.04,"E")),CAC=$G(DUEDAT(F,DUEIENS,.05,"E"))

 .S CAQ=$G(DUEDAT(F,DUEIENS,.06,"E")),CLINCODE=$G(DUEDAT(F,DUEIENS,.07,"I"))

 .S COAGDESC=$G(DUEDAT(F,DUEIENS,1,"E")),ACKREA=$G(DUEDAT(F,DUEIENS,2,"E"))

 .D C S @GBL@(CNT,0)="<DrugUseEvaluation>"

 .D BL(GBL,.CNT,"ServiceReasonCode",SERVREA)

 .D BL(GBL,.CNT,"ProfessionalServiceCode",PROFSERV)

 .D BL(GBL,.CNT,"ServiceResultCode",SVXRC)

 .I $L(CAC_CAQ_COAGDESC) D

 ..D C S @GBL@(CNT,0)="<CoAgent>"

 ..D C S @GBL@(CNT,0)="<CoAgentCode>"

 ..D BL(GBL,.CNT,"Code",CAC)

 ..D BL(GBL,.CNT,"Qualifier",CAQ)

 ..D BL(GBL,.CNT,"Description",COAGDESC)

 ..D C S @GBL@(CNT,0)="</CoAgentCode>"

 ..D C S @GBL@(CNT,0)="</CoAgent>"

 .D BL(GBL,.CNT,"ClinicalSignificanceCode",CLINCODE)

 .D BL(GBL,.CNT,"AcknowledgementReason",ACKREA)

 .D C S @GBL@(CNT,0)="</DrugUseEvaluation>"

ODCS(GL,CNT,ERXIEN,MIEN) ;outbound drug coverage status segment

 N F,DCSIEN,DCSDAT,DCSIENS,DCSTCODE

 S F=52.493117

 S DCSIEN=0 F  S DCSIEN=$O(^PS(52.49,ERXIEN,311,MIEN,7,DCSIEN)) Q:'DCSIEN  D

 .K DCSDAT

 .S DCSIENS=DCSIEN_","_MIEN_","_ERXIEN_","

 .D GETS^DIQ(F,DCSIENS,"**","E","DCSDAT")

 .S DCSTCODE=$G(DCSDAT(F,DCSIENS,.02,"E"))

 .D BL(GBL,.CNT,"DrugCoverageStatusCode",DCSTCODE)

BL(GBL,CNT,TAG,VAR) ;

 Q:VAR=""

 D C S @GBL@(CNT,0)="<"_TAG_">"_$$SYMENC^MXMLUTL(VAR)_"</"_TAG_">"

C ;

 S CNT=$G(CNT)+1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXOH   3881     printed  Feb 18, 2025@23:55:19                                                                                                                                                                                                    Page 2

PSOERXOH  ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126

 +2       ;

 +3        QUIT

ODIAG(GL,CNT,ERXIEN,MIEN) ; outbound diagnosis segment (52.493113)

 +1        NEW F,DIAGIEN,DIAGDAT,DIAGIENS,CIQ,PDXCODE,PDXQUAL,PDXOV

 +2        NEW PDXDESC,PDCOV,SDXCODE,SDXQUAL,SDXDESC,SDXOV

 +3        SET F=52.493113

 +4        IF '$ORDER(^PS(52.49,ERXIEN,311,MIEN,3,0))

               QUIT

 +5        SET DIAGIEN=0

FOR

               SET DIAGIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,3,DIAGIEN))

               if 'DIAGIEN

                   QUIT

               Begin DoDot:1

 +6                KILL DIAGDAT

 +7                SET DIAGIENS=DIAGIEN_","_MIEN_","_ERXIEN_","

 +8                DO GETS^DIQ(F,DIAGIENS,"**","IE","DIAGDAT")

 +9                SET CIQ=$GET(DIAGDAT(F,DIAGIENS,.02,"I"))

                   SET PDXCODE=$GET(DIAGDAT(F,DIAGIENS,1.1,"E"))

                   SET PDXQUAL=$GET(DIAGDAT(F,DIAGIENS,1.2,"I"))

 +10               SET PDXOV=$GET(DIAGDAT(F,DIAGIENS,1.3,"I"))

                   SET PDXDESC=$GET(DIAGDAT(F,DIAGIENS,2,"E"))

                   SET SDXCODE=$GET(DIAGDAT(F,DIAGIENS,3.1,"E"))

 +11               SET SDXQUAL=$GET(DIAGDAT(F,DIAGIENS,3.2,"I"))

                   SET SDXOV=$GET(DIAGDAT(F,DIAGIENS,3.3,"I"))

                   SET SDXDESC=$GET(DIAGDAT(F,DIAGIENS,4,"E"))

 +12               IF $GET(PDXOV)

                       SET PDXOV=$PIECE($$EXTIME^PSOERXO1(PDXOV),"T")

 +13               IF $GET(SDXOV)

                       SET SDXOV=$PIECE($$EXTIME^PSOERXO1(SDXOV),"T")

 +14               DO C

                   SET @GBL@(CNT,0)="<Diagnosis>"

 +15               DO BL(GBL,.CNT,"ClinicalInformationQualifier",CIQ)

 +16               IF $LENGTH(PDXCODE_PDXQUAL_PDXDESC_PDXOV)

                       Begin DoDot:2

 +17                       DO C

                           SET @GBL@(CNT,0)="<Primary>"

 +18                       DO BL(GBL,.CNT,"Code",PDXCODE)

 +19                       DO BL(GBL,.CNT,"Qualifier",PDXQUAL)

 +20                       DO BL(GBL,.CNT,"Description",PDXDESC)

                       End DoDot:2

 +21               IF $LENGTH(PDXOV)

                       Begin DoDot:2

 +22                       DO C

                           SET @GBL@(CNT,0)="<DateOfLastOfficeVisit>"

 +23                       DO BL(GBL,.CNT,"Date",PDXOV)

 +24                       DO C

                           SET @GBL@(CNT,0)="</DateOfLastOfficeVisit>"

                       End DoDot:2

 +25               IF $LENGTH(PDXCODE_PDXQUAL_PDXDESC_PDXOV)

                       Begin DoDot:2

 +26                       DO C

                           SET @GBL@(CNT,0)="</Primary>"

                       End DoDot:2

 +27               IF $LENGTH(SDXCODE_SDXQUAL_SDXDESC_SDXOV)

                       Begin DoDot:2

 +28                       DO C

                           SET @GBL@(CNT,0)="<Secondary>"

 +29                       DO BL(GBL,.CNT,"Code",SDXCODE)

 +30                       DO BL(GBL,.CNT,"Qualifier",SDXQUAL)

 +31                       DO BL(GBL,.CNT,"Description",SDXDESC)

                       End DoDot:2

 +32               IF $LENGTH(SDXOV)

                       Begin DoDot:2

 +33                       DO C

                           SET @GBL@(CNT,0)="<DateOfLastOfficeVisit>"

 +34      ; need to write function to convert this date

                           DO BL(GBL,.CNT,"Date",SDXOV)

 +35                       DO C

                           SET @GBL@(CNT,0)="</DateOfLastOfficeVisit>"

                       End DoDot:2

 +36               IF $LENGTH(SDXCODE_SDXQUAL_SDXDESC_SDXOV)

                       Begin DoDot:2

 +37                       DO C

                           SET @GBL@(CNT,0)="</Secondary>"

                       End DoDot:2

 +38               DO C

                   SET @GBL@(CNT,0)="</Diagnosis>"

               End DoDot:1

 +39       QUIT

ODUE(GL,CNT,ERXIEN,MIEN) ;outbound drug use evaluation segment

 +1        NEW F,DUEIEN,DUEDAT,DUEIENS,SERVREA,PROFSERV,SVXRC

 +2        NEW CAC,CAQ,COAGDESC,CLINCODE,ACKREA

 +3        SET F=52.493116

 +4        IF '$ORDER(^PS(52.49,ERXIEN,311,MIEN,6,0))

               QUIT

 +5        SET DUEIEN=0

FOR

               SET DUEIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,6,DUEIEN))

               if 'DUEIEN

                   QUIT

               Begin DoDot:1

 +6                KILL DUEDAT

 +7                SET DUEIENS=DUEIEN_","_MIEN_","_ERXIEN_","

 +8                DO GETS^DIQ(F,DUEIENS,"**","IE","DUEDAT")

 +9                SET SERVREA=$GET(DUEDAT(F,DUEIENS,.02,"E"))

                   SET PROFSERV=$GET(DUEDAT(F,DUEIENS,.03,"E"))

 +10               SET SVXRC=$GET(DUEDAT(F,DUEIENS,.04,"E"))

                   SET CAC=$GET(DUEDAT(F,DUEIENS,.05,"E"))

 +11               SET CAQ=$GET(DUEDAT(F,DUEIENS,.06,"E"))

                   SET CLINCODE=$GET(DUEDAT(F,DUEIENS,.07,"I"))

 +12               SET COAGDESC=$GET(DUEDAT(F,DUEIENS,1,"E"))

                   SET ACKREA=$GET(DUEDAT(F,DUEIENS,2,"E"))

 +13               DO C

                   SET @GBL@(CNT,0)="<DrugUseEvaluation>"

 +14               DO BL(GBL,.CNT,"ServiceReasonCode",SERVREA)

 +15               DO BL(GBL,.CNT,"ProfessionalServiceCode",PROFSERV)

 +16               DO BL(GBL,.CNT,"ServiceResultCode",SVXRC)

 +17               IF $LENGTH(CAC_CAQ_COAGDESC)

                       Begin DoDot:2

 +18                       DO C

                           SET @GBL@(CNT,0)="<CoAgent>"

 +19                       DO C

                           SET @GBL@(CNT,0)="<CoAgentCode>"

 +20                       DO BL(GBL,.CNT,"Code",CAC)

 +21                       DO BL(GBL,.CNT,"Qualifier",CAQ)

 +22                       DO BL(GBL,.CNT,"Description",COAGDESC)

 +23                       DO C

                           SET @GBL@(CNT,0)="</CoAgentCode>"

 +24                       DO C

                           SET @GBL@(CNT,0)="</CoAgent>"

                       End DoDot:2

 +25               DO BL(GBL,.CNT,"ClinicalSignificanceCode",CLINCODE)

 +26               DO BL(GBL,.CNT,"AcknowledgementReason",ACKREA)

 +27               DO C

                   SET @GBL@(CNT,0)="</DrugUseEvaluation>"

               End DoDot:1

 +28       QUIT

ODCS(GL,CNT,ERXIEN,MIEN) ;outbound drug coverage status segment

 +1        NEW F,DCSIEN,DCSDAT,DCSIENS,DCSTCODE

 +2        SET F=52.493117

 +3        SET DCSIEN=0

FOR

               SET DCSIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,7,DCSIEN))

               if 'DCSIEN

                   QUIT

               Begin DoDot:1

 +4                KILL DCSDAT

 +5                SET DCSIENS=DCSIEN_","_MIEN_","_ERXIEN_","

 +6                DO GETS^DIQ(F,DCSIENS,"**","E","DCSDAT")

 +7                SET DCSTCODE=$GET(DCSDAT(F,DCSIENS,.02,"E"))

 +8                DO BL(GBL,.CNT,"DrugCoverageStatusCode",DCSTCODE)

               End DoDot:1

 +9        QUIT

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

PSOERXOH.m