PSOERXOI ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
;;7.0;OUTPATIENT PHARMACY;**581,746**;DEC 1997;Build 106
;
Q
SIG(GL,CNT,ERXIEN,MIEN) ;
N SIGTEXT,SNOMED,FMTVER,SIGCFT,SIGDAT,F,IENS,SIGL
S F=52.49311
S IENS=MIEN_","_ERXIEN_","
D GETS^DIQ(F,IENS,"9.1;9.2;15","E","SIGDAT")
S SNOMED=$G(SIGDAT(F,IENS,9.1,"E"))
S FMTVER=$G(SIGDAT(F,IENS,9.2,"E"))
S SIGCFT=$G(SIGDAT(F,IENS,15,"E"))
D C S @GL@(CNT,0)="<Sig>"
S SIGTEXT=""
S SIGL=0 F S SIGL=$O(^PS(52.49,ERXIEN,311,MIEN,8,SIGL)) Q:'SIGL D
.S SIGTEXT=SIGTEXT_$G(^PS(52.49,ERXIEN,311,MIEN,8,SIGL,0))_" "
S $E(SIGTEXT,$L(SIGTEXT))=""
D BL(GL,.CNT,"SigText",SIGTEXT)
D C S @GL@(CNT,0)="<CodeSystem>"
D BL(GL,.CNT,"SNOMEDVersion",SNOMED),BL(GL,.CNT,"FMTVersion",FMTVER)
D C S @GL@(CNT,0)="</CodeSystem>"
D MEDINST^PSOERXOJ(GL,.CNT,ERXIEN,MIEN)
D SIGI4USE(GL,.CNT,ERXIEN,MIEN)
D SIGMDR(GL,.CNT,ERXIEN,MIEN)
D BL(GL,.CNT,"ClarifyingFreeText",SIGCFT)
D C S @GL@(CNT,0)="</Sig>"
Q
; sig level maximum dose restriction
SIGMDR(GL,CNT,ERXIEN,MIEN) ;
N MDRIEN,MDRIENS,MDRV,MDRDAT,F,MDRV1,RUC,RUQ,RUT,DVAL,DUC,DUQ,DUT,RFC,RFQ,RFT,CFTEXT
S F=52.4931114
I '$O(^PS(52.49,ERXIEN,311,MIEN,14,0)) Q
S MDRIEN=0 F S MDRIEN=$O(^PS(52.49,ERXIEN,311,MIEN,14,MDRIEN)) Q:'MDRIEN D
.K MDRDAT
.S MDRIENS=MDRIEN_","_MIEN_","_ERXIEN_","
.D GETS^DIQ(F,MDRIENS,"**","E","MDRDAT")
.S MDRV1=$G(MDRDAT(F,MDRIENS,1,"E")),RUC=$G(MDRDAT(F,MDRIENS,2,"E")),RUQ=$G(MDRDAT(F,MDRIENS,3,"E")),RUT=$G(MDRDAT(F,MDRIENS,4,"E"))
.S DVAL=$G(MDRDAT(F,MDRIENS,5,"E")),DUC=$G(MDRDAT(F,MDRIENS,6,"E")),DUQ=$G(MDRDAT(F,MDRIENS,7,"E")),DUT=$G(MDRDAT(F,MDRIENS,8,"E"))
.S RFC=$G(MDRDAT(F,MDRIENS,9,"E")),RFQ=$G(MDRDAT(F,MDRIENS,10,"E")),RFT=$G(MDRDAT(F,MDRIENS,11,"E"))
.S CFTEXT=$G(MDRDAT(F,MDRIENS,12,"E"))
.D C S @GL@(CNT,0)="<MaximumDoseRestriction>"
.D BL(.GL,.CNT,"MaximumDoseRestrictionNumericValue",MDRV1)
.D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionForm",RFT,RFQ,RFC)
.D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionUnits",RUT,RUQ,RUC)
.D BL(.GL,.CNT,"MaximumDoseRestrictionDurationValue",DVAL)
.D SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionDurationUnit",DUT,DUQ,DUC)
.D BL(.GL,.CNT,"MaximumDoseRestrictionClarifyingFreeText",CFTEXT)
.D C S @GL@(CNT,0)="</MaximumDoseRestriction>"
Q
; indication for use at the sig level (medication prescribed)
SIGI4USE(GL,CNT,ERXIEN,MIEN) ;
N F,IFUIEN,IFUIENS,IFUDAT,IPC,IPQ,IPT,IC,IQ,IT,IVC1,IVQ1,IVT1,IVM,IVC2,IVQ2,IVT2,IVUC,IVUQ,IVUT
N IUOMC,IUOMQ,IUOMT
S F=52.4931113
; dont build anything if the subscript is missing
Q:'$O(^PS(52.49,ERXIEN,311,MIEN,13,0))
S IFUIEN=0,IFUIEN=$O(^PS(52.49,ERXIEN,311,MIEN,13,IFUIEN)) Q:'IFUIEN D
.K IFUDAT
.S IFUIENS=IFUIEN_","_MIEN_","_ERXIEN_","
.D C S @GL@(CNT,0)="<IndicationForUse>"
.D GETS^DIQ(F,IFUIENS,"**","E","IFUDAT")
.S IPC=$G(IFUDAT(F,IFUIENS,1,"E")),IPQ=$G(IFUDAT(F,IFUIENS,2,"E")),IPT=$G(IFUDAT(F,IFUIENS,3,"E"))
.S IC=$G(IFUDAT(F,IFUIENS,4,"E")),IQ=$G(IFUDAT(F,IFUIENS,5,"E")),IT=$G(IFUDAT(F,IFUIENS,6,"E"))
.S IVC1=$G(IFUDAT(F,IFUIENS,7,"E")),IVQ1=$G(IFUDAT(F,IFUIENS,8,"E")),IVT1=$G(IFUDAT(F,IFUIENS,9,"E"))
.S IVM=$G(IFUDAT(F,IFUIENS,10,"E"))
.S IVC2=$G(IFUDAT(F,IFUIENS,11,"E")),IVQ2=$G(IFUDAT(F,IFUIENS,12,"E")),IVT2=$G(IFUDAT(F,IFUIENS,13,"E"))
.S IVUC=$G(IFUDAT(F,IFUIENS,14,"E")),IVUQ=$G(IFUDAT(F,IFUIENS,15,"E")),IVUT=$G(IFUDAT(F,IFUIENS,16,"E"))
.S IUOMC=$G(IFUDAT(F,IFUIENS,17,"E")),IUOMQ=$G(IFUDAT(F,IFUIENS,18,"E")),IUOMT=$G(IFUDAT(F,IFUIENS,19,"E"))
.D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationPrescursor",IPT,IPQ,IPC)
.D SIGTYPE^PSOERXOU(GL,.CNT,"Indication",IT,IQ,IC)
.D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT1,IVQ1,IVC1)
.I $L(IVM) D BL(GL,.CNT,"IndicationVariableModifier",IVM)
.D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT2,IVQ2,IVC2)
.D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnit",IVUT,IVUQ,IVUC)
.D SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnitOfMeasure",IUOMT,IUOMQ,IUOMC)
D C S @GL@(CNT,0)="</IndicationForUse>"
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[HPSOERXOI 4149 printed Nov 22, 2024@17:38:53 Page 2
PSOERXOI ;ALB/BWF - eRx parsing Utilities ; 11/14/2019 3:46pm
+1 ;;7.0;OUTPATIENT PHARMACY;**581,746**;DEC 1997;Build 106
+2 ;
+3 QUIT
SIG(GL,CNT,ERXIEN,MIEN) ;
+1 NEW SIGTEXT,SNOMED,FMTVER,SIGCFT,SIGDAT,F,IENS,SIGL
+2 SET F=52.49311
+3 SET IENS=MIEN_","_ERXIEN_","
+4 DO GETS^DIQ(F,IENS,"9.1;9.2;15","E","SIGDAT")
+5 SET SNOMED=$GET(SIGDAT(F,IENS,9.1,"E"))
+6 SET FMTVER=$GET(SIGDAT(F,IENS,9.2,"E"))
+7 SET SIGCFT=$GET(SIGDAT(F,IENS,15,"E"))
+8 DO C
SET @GL@(CNT,0)="<Sig>"
+9 SET SIGTEXT=""
+10 SET SIGL=0
FOR
SET SIGL=$ORDER(^PS(52.49,ERXIEN,311,MIEN,8,SIGL))
if 'SIGL
QUIT
Begin DoDot:1
+11 SET SIGTEXT=SIGTEXT_$GET(^PS(52.49,ERXIEN,311,MIEN,8,SIGL,0))_" "
End DoDot:1
+12 SET $EXTRACT(SIGTEXT,$LENGTH(SIGTEXT))=""
+13 DO BL(GL,.CNT,"SigText",SIGTEXT)
+14 DO C
SET @GL@(CNT,0)="<CodeSystem>"
+15 DO BL(GL,.CNT,"SNOMEDVersion",SNOMED)
DO BL(GL,.CNT,"FMTVersion",FMTVER)
+16 DO C
SET @GL@(CNT,0)="</CodeSystem>"
+17 DO MEDINST^PSOERXOJ(GL,.CNT,ERXIEN,MIEN)
+18 DO SIGI4USE(GL,.CNT,ERXIEN,MIEN)
+19 DO SIGMDR(GL,.CNT,ERXIEN,MIEN)
+20 DO BL(GL,.CNT,"ClarifyingFreeText",SIGCFT)
+21 DO C
SET @GL@(CNT,0)="</Sig>"
+22 QUIT
+23 ; sig level maximum dose restriction
SIGMDR(GL,CNT,ERXIEN,MIEN) ;
+1 NEW MDRIEN,MDRIENS,MDRV,MDRDAT,F,MDRV1,RUC,RUQ,RUT,DVAL,DUC,DUQ,DUT,RFC,RFQ,RFT,CFTEXT
+2 SET F=52.4931114
+3 IF '$ORDER(^PS(52.49,ERXIEN,311,MIEN,14,0))
QUIT
+4 SET MDRIEN=0
FOR
SET MDRIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,14,MDRIEN))
if 'MDRIEN
QUIT
Begin DoDot:1
+5 KILL MDRDAT
+6 SET MDRIENS=MDRIEN_","_MIEN_","_ERXIEN_","
+7 DO GETS^DIQ(F,MDRIENS,"**","E","MDRDAT")
+8 SET MDRV1=$GET(MDRDAT(F,MDRIENS,1,"E"))
SET RUC=$GET(MDRDAT(F,MDRIENS,2,"E"))
SET RUQ=$GET(MDRDAT(F,MDRIENS,3,"E"))
SET RUT=$GET(MDRDAT(F,MDRIENS,4,"E"))
+9 SET DVAL=$GET(MDRDAT(F,MDRIENS,5,"E"))
SET DUC=$GET(MDRDAT(F,MDRIENS,6,"E"))
SET DUQ=$GET(MDRDAT(F,MDRIENS,7,"E"))
SET DUT=$GET(MDRDAT(F,MDRIENS,8,"E"))
+10 SET RFC=$GET(MDRDAT(F,MDRIENS,9,"E"))
SET RFQ=$GET(MDRDAT(F,MDRIENS,10,"E"))
SET RFT=$GET(MDRDAT(F,MDRIENS,11,"E"))
+11 SET CFTEXT=$GET(MDRDAT(F,MDRIENS,12,"E"))
+12 DO C
SET @GL@(CNT,0)="<MaximumDoseRestriction>"
+13 DO BL(.GL,.CNT,"MaximumDoseRestrictionNumericValue",MDRV1)
+14 DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionForm",RFT,RFQ,RFC)
+15 DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionUnits",RUT,RUQ,RUC)
+16 DO BL(.GL,.CNT,"MaximumDoseRestrictionDurationValue",DVAL)
+17 DO SIGTYPE^PSOERXOU(.GL,.CNT,"MaximumDoseRestrictionDurationUnit",DUT,DUQ,DUC)
+18 DO BL(.GL,.CNT,"MaximumDoseRestrictionClarifyingFreeText",CFTEXT)
+19 DO C
SET @GL@(CNT,0)="</MaximumDoseRestriction>"
End DoDot:1
+20 QUIT
+21 ; indication for use at the sig level (medication prescribed)
SIGI4USE(GL,CNT,ERXIEN,MIEN) ;
+1 NEW F,IFUIEN,IFUIENS,IFUDAT,IPC,IPQ,IPT,IC,IQ,IT,IVC1,IVQ1,IVT1,IVM,IVC2,IVQ2,IVT2,IVUC,IVUQ,IVUT
+2 NEW IUOMC,IUOMQ,IUOMT
+3 SET F=52.4931113
+4 ; dont build anything if the subscript is missing
+5 if '$ORDER(^PS(52.49,ERXIEN,311,MIEN,13,0))
QUIT
+6 SET IFUIEN=0
SET IFUIEN=$ORDER(^PS(52.49,ERXIEN,311,MIEN,13,IFUIEN))
if 'IFUIEN
QUIT
Begin DoDot:1
+7 KILL IFUDAT
+8 SET IFUIENS=IFUIEN_","_MIEN_","_ERXIEN_","
+9 DO C
SET @GL@(CNT,0)="<IndicationForUse>"
+10 DO GETS^DIQ(F,IFUIENS,"**","E","IFUDAT")
+11 SET IPC=$GET(IFUDAT(F,IFUIENS,1,"E"))
SET IPQ=$GET(IFUDAT(F,IFUIENS,2,"E"))
SET IPT=$GET(IFUDAT(F,IFUIENS,3,"E"))
+12 SET IC=$GET(IFUDAT(F,IFUIENS,4,"E"))
SET IQ=$GET(IFUDAT(F,IFUIENS,5,"E"))
SET IT=$GET(IFUDAT(F,IFUIENS,6,"E"))
+13 SET IVC1=$GET(IFUDAT(F,IFUIENS,7,"E"))
SET IVQ1=$GET(IFUDAT(F,IFUIENS,8,"E"))
SET IVT1=$GET(IFUDAT(F,IFUIENS,9,"E"))
+14 SET IVM=$GET(IFUDAT(F,IFUIENS,10,"E"))
+15 SET IVC2=$GET(IFUDAT(F,IFUIENS,11,"E"))
SET IVQ2=$GET(IFUDAT(F,IFUIENS,12,"E"))
SET IVT2=$GET(IFUDAT(F,IFUIENS,13,"E"))
+16 SET IVUC=$GET(IFUDAT(F,IFUIENS,14,"E"))
SET IVUQ=$GET(IFUDAT(F,IFUIENS,15,"E"))
SET IVUT=$GET(IFUDAT(F,IFUIENS,16,"E"))
+17 SET IUOMC=$GET(IFUDAT(F,IFUIENS,17,"E"))
SET IUOMQ=$GET(IFUDAT(F,IFUIENS,18,"E"))
SET IUOMT=$GET(IFUDAT(F,IFUIENS,19,"E"))
+18 DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationPrescursor",IPT,IPQ,IPC)
+19 DO SIGTYPE^PSOERXOU(GL,.CNT,"Indication",IT,IQ,IC)
+20 DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT1,IVQ1,IVC1)
+21 IF $LENGTH(IVM)
DO BL(GL,.CNT,"IndicationVariableModifier",IVM)
+22 DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValue",IVT2,IVQ2,IVC2)
+23 DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnit",IVUT,IVUQ,IVUC)
+24 DO SIGTYPE^PSOERXOU(GL,.CNT,"IndicationValueUnitOfMeasure",IUOMT,IUOMQ,IUOMC)
End DoDot:1
+25 DO C
SET @GL@(CNT,0)="</IndicationForUse>"
+26 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
