Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERUT7

PSOERUT7.m

Go to the documentation of this file.
  1. PSOERUT7 ;ALB/MFR - eRx Drug Validation (VD) Utilities; 06/25/2023 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**746,769**;DEC 1997;Build 26
  1. ;
  1. DOSEDUE(MODE,NPSPC,ERXIEN,SDERXFLG) ; Sets Dosage & DUE Information
  1. ; Input: MODE - Display Mode: "RS": Roll & Scroll | "LM": ListMan
  1. ; NMSPC - ListMan Temp Global Namespace (e.g., "PSOERXP1")
  1. ; ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; (o)SDERXFLG - Single eRx View/Display Flag - 1: Single eRx View/Display side-by-side | 0: Existing Functionality
  1. N ERXDOSE,DOSE,XE,XEI,XV,XVI,WRPDOSE,I,DISPUNTS,DOSEX,PDUE,DUESEQ,ERXLINES,VALINES,COAGENT,REASON,RESULT,ACK,VAPATINS,ALLLN,ERXALLS
  1. ;
  1. D PDUEDATA^PSOERXU9(.PDUE,ERXIEN,1)
  1. S XEI=0,LMLINE=LINE-1
  1. S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Prescriber Drug Use Evaluation:"
  1. I '$D(PDUE) D
  1. . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" None",HIGHLN(LMLINE,2)=4
  1. E D
  1. . F DUESEQ=1:1 Q:'$D(PDUE(DUESEQ)) D
  1. . . S COAGENT=$P(PDUE(DUESEQ),"^",8)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Co-Agent: "_$$COMPARE^PSOERUT0(MODE,$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
  1. . . I $L(COAGENT)>29 D
  1. . . . F I=1:1 S COAGENT=$E(COAGENT,30,999) Q:COAGENT="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(COAGENT,1,29),$E(COAGENT,1,29),11,,LMLINE)
  1. . . S REASON=$P(PDUE(DUESEQ),"^",2) I $$PRESOLV^PSOERXA1(REASON,"REA") S REASON=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(REASON,"REA"),.02)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Reason: "_$$COMPARE^PSOERUT0(MODE,$E(REASON,1,30),$E(REASON,1,30),9,,LMLINE)
  1. . . I $L(REASON)>31 D
  1. . . . F I=1:1 S REASON=$E(REASON,32,999) Q:REASON="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(REASON,1,31),$E(REASON,1,31),9,,LMLINE)
  1. . . S RESULT=$P(PDUE(DUESEQ),"^",4) I $$PRESOLV^PSOERXA1(RESULT,"RES") S RESULT=$$GET1^DIQ(52.45,$$PRESOLV^PSOERXA1(RESULT,"RES"),.02)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Result: "_$$COMPARE^PSOERUT0(MODE,$E(RESULT,1,30),$E(RESULT,1,30),9,,LMLINE)
  1. . . I $L(RESULT)>31 D
  1. . . . F I=1:1 S RESULT=$E(RESULT,32,999) Q:RESULT="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(RESULT,1,31),$E(RESULT,1,31),9,,LMLINE)
  1. . . S ACK=$P(PDUE(DUESEQ),"^",9)
  1. . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="Override: "_$$COMPARE^PSOERUT0(MODE,$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
  1. . . I $L(ACK)>29 D
  1. . . . F I=1:1 S ACK=$E(ACK,30,999) Q:ACK="" D
  1. . . . . S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)=" "_$$COMPARE^PSOERUT0(MODE,$E(ACK,1,29),$E(ACK,1,29),11,,LMLINE)
  1. . . I $O(PDUE(DUESEQ)) S XEI=XEI+1,LMLINE=LMLINE+1,ERXLINES(XEI)="......................................"
  1. ;
  1. D ERXDOSE^PSOERUT4(ERXIEN,.ERXDOSE)
  1. S XVI=0,LMLINE=LINE-1
  1. I '$D(ERXDOSE),'$D(PDUE) D
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S($G(SDERXFLG):"",MODE="LM":"2)",1:" ")_$S($G(SDERXFLG):"",1:" ")_" Dosage:"
  1. . I MODE="LM",'$G(SDERXFLG) S UNDERLN(LMLINE,41)=2
  1. F DOSE=1:1 Q:'$D(ERXDOSE("DOSE",DOSE)) D
  1. . I '$G(ERXDOSE("DOSE ORDERED",DOSE)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0(MODE,ERXDOSE("VERB",DOSE),ERXDOSE("VERB",DOSE),54,,LMLINE)
  1. . S DOSEX=ERXDOSE("DOSE",DOSE) I $E(DOSEX,1)=".",$G(ERXDOSE("DOSE ORDERED",DOSE)) S DOSEX="0"_DOSEX
  1. . I $G(ERXDOSE("UNITS",DOSE))]"" S DOSEX=DOSEX_" ("_$$GET1^DIQ(50.607,ERXDOSE("UNITS",DOSE),.01)_")"
  1. . D WRAP^PSOERUT(DOSEX,24,.WRPDOSE)
  1. . S XVI=XVI+1,LMLINE=LMLINE+1
  1. . S VALINES(XVI)=$S($G(SDERXFLG):" ",MODE="LM"&(DOSE=1):"2)",1:" ")_" Dosage: "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(1,0)),$G(WRPDOSE(1,0)),54,,LMLINE)
  1. . I MODE="LM",DOSE=1,'$G(SDERXFLG) S UNDERLN(LMLINE,41)=2
  1. . F I=2:1 Q:'$D(WRPDOSE(I)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0("LM",$G(WRPDOSE(I,0)),$G(WRPDOSE(I,0)),54,,LMLINE)
  1. . I $G(ERXDOSE("DOSE ORDERED",DOSE)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Verb: "_$$COMPARE^PSOERUT0(MODE,$G(ERXDOSE("VERB",DOSE)),$G(ERXDOSE("VERB",DOSE)),54,,LMLINE)
  1. . . S DISPUNTS=$S($E(ERXDOSE("DOSE ORDERED",DOSE),1)=".":"0",1:"")_ERXDOSE("DOSE ORDERED",DOSE)
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="Disp. Units: "_$$COMPARE^PSOERUT0(MODE,$E(DISPUNTS,1,27),$E(DISPUNTS,1,27),54,,LMLINE)
  1. . . I $L(DISPUNTS)>27 D
  1. . . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$$COMPARE^PSOERUT0(MODE,$E(DISPUNTS,28,999),$E(DISPUNTS,28,999),41)
  1. . I $G(ERXDOSE("NOUN",DOSE))'="" D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Noun: "_$$COMPARE^PSOERUT0(MODE,ERXDOSE("NOUN",DOSE),ERXDOSE("NOUN",DOSE),54,,LMLINE)
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Route: "_$$COMPARE^PSOERUT0(MODE,$G(ERXDOSE("ROUTE",DOSE)),$G(ERXDOSE("ROUTE",DOSE)),54,,LMLINE)
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Schedule: "_$$COMPARE^PSOERUT0(MODE,$G(ERXDOSE("SCHEDULE",DOSE)),$G(ERXDOSE("SCHEDULE",DOSE)),54,,LMLINE)
  1. . I $G(ERXDOSE("DURATION",DOSE))'="" D
  1. . . N DUR S DUR=ERXDOSE("DURATION",DOSE)
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" Duration: "_$$COMPARE^PSOERUT0(MODE,DUR_" "_$$FREQ^PSOERUT4(DUR),DUR_" "_$$FREQ^PSOERUT4(DUR),54,,LMLINE)
  1. . I $G(ERXDOSE("CONJUNCTION",DOSE))'="" D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="Conjunction: "_$$COMPARE^PSOERUT0(MODE,ERXDOSE("CONJUNCTION",DOSE),ERXDOSE("CONJUNCTION",DOSE),54,,LMLINE)
  1. ;
  1. ; - Patient Instructions
  1. S VAPATINS=$$GET1^DIQ(52.49,ERXIEN,27)
  1. I $G(VAPATINS)'=""!(MODE="LM") D
  1. . I MODE="LM",'$G(SDERXFLG) S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)="________________________________________"
  1. . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=$S($G(SDERXFLG):"",MODE="LM":"3)",1:"")_"Patient Instructions:"
  1. . I MODE="LM",'$G(SDERXFLG) S UNDERLN(LMLINE,41)=2
  1. . K VARR D WRAP^PSOERUT($G(VAPATINS),39,.VARR)
  1. . F I=1:1 Q:'$D(VARR(I)) D
  1. . . S XVI=XVI+1,LMLINE=LMLINE+1,VALINES(XVI)=" "_$$COMPARE^PSOERUT0(MODE,$G(VARR(I,0)),$G(VARR(I,0)),42,,LMLINE)
  1. ;
  1. ; - Setting eRx Prescriber Drug Use Evaluation (DUE), Matched Dosage and Patient Instructions
  1. F ALLLN=1:1 Q:('$D(ERXLINES(ALLLN))&'$D(VALINES(ALLLN))) D
  1. . S ERXALLS=$G(ERXLINES(ALLLN)),VAALLS=$G(VALINES(ALLLN))
  1. . S XE=$G(ERXLINES(ALLLN))
  1. . S XV="|"_$G(VALINES(ALLLN))
  1. . D ADDLINE^PSOERUT0(MODE,NMSPC,XE,XV)
  1. Q
  1. ;
  1. SAMEDOSE(ERX,RX) ; Returns if the eRx Dosage and VistA Rx Dosage are the same
  1. ; Input: ERX - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; RX - Pointer to PRESCRIPTION file (#52)
  1. ;Output: SAMEDOSE - 1: Exact same Dose | 0 - Different Dose
  1. N SAMEDOSE,EDOSE,VDOSE,NEXTE,NEXTV
  1. D ERXDOSE^PSOERUT4(ERX,.EDOSE,1)
  1. D VARXDOSE^PSOERUT4(RX,.VDOSE)
  1. S SAMEDOSE=1
  1. S NEXTE="EDOSE" F S NEXTE=$Q(@NEXTE) Q:NEXTE="" D I 'SAMEDOSE Q
  1. . S NEXTV="VDOSE("_$P(NEXTE,"(",2)
  1. . I $G(@NEXTE)'=$G(@NEXTV) S SAMEDOSE=0
  1. Q SAMEDOSE