PSOERXOH ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
;
Q
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>"
Q
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>"
Q
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)
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[HPSOERXOH 3881 printed Dec 13, 2024@02:28:53 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
