PXRMDRUG ;SLC/PKR - Handle drug findings. ;12/15/2010
;;2.0;CLINICAL REMINDERS;**4,6,12,18**;Feb 04, 2005;Build 152
;DBIA #5187 for PSSCLINR
;
;===============================================
DEVAL(DFN,FINDPA,DEFARR,FINDING,RXTYL,DRUG,POI,FIEVAL) ;Evaluate a drug
;finding.
I DRUG=0,POI=0 S FIEVAL=0 Q
N DTERM,FIEVT
;Create the pseudo term.
S DTERM(0)="DTERM",DTERM("IEN")=0
I $D(RXTYL("I")),DRUG>0 D
. M DTERM(20,1)=DEFARR(20,FINDING)
. S $P(DTERM(20,1,0),U,1)=DRUG_";PS(55,"
. S DTERM("E","PS(55,",DRUG,1)=""
I $D(RXTYL("O")),DRUG>0 D
. M DTERM(20,3)=DEFARR(20,FINDING)
. S $P(DTERM(20,3,0),U,1)=DRUG_";PSRX("
. S DTERM("E","PSRX(",DRUG,3)=""
I $D(RXTYL("N")),POI>0 D
. M DTERM(20,2)=DEFARR(20,FINDING)
. S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
. S DTERM("E","PS(55NVA,",POI,2)=""
K FIEVT
D IEVALTER^PXRMTERM(DFN,.FINDPA,.DTERM,1,.FIEVT)
M FIEVAL=FIEVT(1)
I FIEVAL S FIEVAL("FINDING")=DRUG_";PSDRUG(",FIEVAL("DISPENSE DRUG")=DRUG
Q
;
;===============================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate drug findings.
N DRUGIEN,DTERM,FIEVT,FINDPA,FINDING
N NOINDEX,POI,RXTYL
S NOINDEX=0
I $G(^PXRMINDX(52,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("D",PXRMITEM,52)
. S NOINDEX=1
I $G(^PXRMINDX(55,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("D",PXRMITEM,55)
. S NOINDEX=1
S DRUGIEN=""
F S DRUGIEN=$O(DEFARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
. S POI=$$ITEM^PSSCLINR(DRUGIEN)
. S FINDING=""
. F S FINDING=$O(DEFARR("E",ENODE,DRUGIEN,FINDING)) Q:+FINDING=0 D
.. I NOINDEX S FIEVAL(FINDING)=0 Q
.. M FINDPA=DEFARR(20,FINDING)
.. K FIEVT,RXTYL
..;Determine where we search.
.. D SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL)
.. D DEVAL(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUGIEN,POI,.FIEVT)
.. M FIEVAL(FINDING)=FIEVT
Q
;
;===============================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate drug terms for
;building patient lists.
N BDT,EDT,DATE,DFN,DRUGIEN,ITEM,FILENUM,IND,LIST,NFOUND,NOCC,NOINDEX
N PFINDPA,POI,RXTYL,TEMP,TF,TFINDPA,TFINDING,TGLIST,TLIST
S NOINDEX=0
I $G(^PXRMINDX(52,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
. S NOINDEX=1
I $G(^PXRMINDX(55,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
. S NOINDEX=1
I NOINDEX Q
S TGLIST="EVALPL_PXRMDRUG"
K ^TMP($J,TGLIST)
S DRUGIEN=""
F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
. S POI=$$ITEM^PSSCLINR(DRUGIEN)
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D
.. K PFINDPA,TFINDPA
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
..;Determine where we search.
.. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
.. I $D(RXTYL("I")) D GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST)
.. I $D(RXTYL("N")),POI'="" D GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST)
.. I $D(RXTYL("O")) D GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST)
;Return the NOCC most recent results for each DFN.
S NOCC=$P(FINDPA(0),U,14)
S NOCC=$S(NOCC<0:-NOCC,NOCC="":1,1:NOCC)
F TF=0,1 D
. S DFN=0
. F S DFN=$O(^TMP($J,TGLIST,TF,DFN)) Q:DFN="" D
.. K TLIST
.. S ITEM=""
.. F S ITEM=$O(^TMP($J,TGLIST,TF,DFN,ITEM)) Q:ITEM="" D
... S NFOUND=""
... F S NFOUND=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND)) Q:NFOUND="" D
.... S FILENUM=""
.... F S FILENUM=$O(^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)) Q:FILENUM="" D
..... S TEMP=^TMP($J,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)
..... S DATE=+$P(TEMP,U,3)
..... S TLIST(TF,DATE,ITEM,NFOUND,FILENUM)=""
.. S DATE="",NFOUND=0
.. F S DATE=$O(TLIST(TF,DATE),-1) Q:(DATE="")!(NFOUND=NOCC) D
... S ITEM=""
... F S ITEM=$O(TLIST(TF,DATE,ITEM)) Q:(ITEM="")!(NFOUND=NOCC) D
.... S IND=""
.... F S IND=$O(TLIST(TF,DATE,ITEM,IND)) Q:(IND="")!(NFOUND=NOCC) D
..... S FILENUM=""
..... F S FILENUM=$O(TLIST(TF,DATE,ITEM,IND,FILENUM)) Q:(FILENUM="")!(NFOUND=NOCC) D
...... S NFOUND=NFOUND+1
...... S ^TMP($J,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($J,TGLIST,TF,DFN,ITEM,IND,FILENUM)
K ^TMP($J,TGLIST)
Q
;
;===============================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate drug terms.
N DATEORDR,DRUGIEN,DTERM,DTFIEVAL,IND,JND,NOINDEX,PFINDPA,POI
N RXTYL,TEMP,TFINDING,TFINDPA
N DATEORDR,NOCC,SDIR
S NOINDEX=0
I $G(^PXRMINDX(52,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
. S NOINDEX=1
I $G(^PXRMINDX(55,"DATE BUILT"))="" D
. D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
. S NOINDEX=1
;Set NOCC and SDIR.
S NOCC=$P(FINDPA(0),U,14)
I NOCC="" S NOCC=1
S SDIR=$S(NOCC<0:+1,1:-1)
S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
S DRUGIEN=""
F S DRUGIEN=$O(TERMARR("E",ENODE,DRUGIEN)) Q:+DRUGIEN=0 D
. S POI=$$ITEM^PSSCLINR(DRUGIEN)
. S TFINDING=""
. F S TFINDING=$O(TERMARR("E",ENODE,DRUGIEN,TFINDING)) Q:+TFINDING=0 D
.. S TFIEVAL(TFINDING)=0
.. I NOINDEX Q
.. K DTERM,DTFIEVAL,PFINDPA,TFINDPA
.. S DTERM(0)="DTERM",DTERM("IEN")=0
.. M TFINDPA=TERMARR(20,TFINDING)
..;Set the finding parameters.
.. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
..;Determine where we search.
.. D SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
.. I $D(RXTYL("I")) D
... M DTERM(20,1)=TERMARR(20,TFINDING)
... S $P(DTERM(20,1,0),U,1)=DRUGIEN_";PS(55,"
... S DTERM("E","PS(55,",DRUGIEN,1)=""
.. I $D(RXTYL("N")),POI'="" D
... M DTERM(20,2)=TERMARR(20,TFINDING)
... S $P(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
... S DTERM("E","PS(55NVA,",POI,2)=""
.. I $D(RXTYL("O")) D
... M DTERM(20,3)=TERMARR(20,TFINDING)
... S $P(DTERM(20,3,0),U,1)=DRUGIEN_";PSRX("
... S DTERM("E","PSRX(",DRUGIEN,3)=""
.. D IEVALTER^PXRMTERM(DFN,.PFINDPA,.DTERM,TFINDING,.DTFIEVAL)
.. D DORDER^PXRMTERM(.DTFIEVAL,.DATEORDR)
.. D COPY^PXRMTERM(NOCC,SDIR,.DTFIEVAL,.DATEORDR,TFINDING,.TFIEVAL,0)
..;Save the dispense drug
.. S JND=0
.. F S JND=+$O(TFIEVAL(TFINDING,JND)) Q:JND=0 S TFIEVAL(TFINDING,JND,"DISPENSE DRUG")=DRUGIEN
Q
;
;===============================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
N DRUG,DRUGIEN,IND,FTYPE,NAME,PFIEVAL,TEMP
I $D(IFIEVAL("TERM FINDING")) S NLINES=NLINES+1,TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
S DRUGIEN=IFIEVAL("DISPENSE DRUG")
S DRUG=$$DRUG^PSSCLINR(DRUGIEN)
S NAME="Drug: "_DRUG_" = "
S NLINES=NLINES+1
S TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S TEMP=IFIEVAL(IND,"FINDING")
. S FTYPE=$P(TEMP,";",2)
. K PFIEVAL M PFIEVAL=IFIEVAL(IND)
. S PFIEVAL("DISPENSE DRUG")=DRUG
. I FTYPE="PS(55," D MHVOUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
. I FTYPE="PS(55NVA," D MHVOUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
. I FTYPE="PSRX(" D MHVOUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
S NLINES=NLINES+1,TEXT(NLINES)=""
Q
;
;===============================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
;maintenance output.
N DRUG,FTYPE,IND,PFIEVAL,TEMP,TEXTOUT
I $D(IFIEVAL("TERM FINDING")) S NLINES=NLINES+1,TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
S DRUG=$$DRUG^PSSCLINR(IFIEVAL("DISPENSE DRUG"))
S NLINES=NLINES+1,TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
S IND=0
F S IND=+$O(IFIEVAL(IND)) Q:IND=0 D
. S TEMP=IFIEVAL(IND,"FINDING")
. S FTYPE=$P(TEMP,";",2)
. K PFIEVAL M PFIEVAL=IFIEVAL(IND)
. S PFIEVAL("DISPENSE DRUG")=DRUG
. I FTYPE="PS(55," D OUTPUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
. I FTYPE="PS(55NVA," D OUTPUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
. I FTYPE="PSRX(" D OUTPUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT) Q
Q
;
;===============================================
CLORGNT(FINDING) ;Generate drug class or VA Generic text.
N DRUGCLAS,IEN,GBL,TEXT
S TEXT=""
S IEN=$P(FINDING,";",1)
S GBL=$P(FINDING,";",2)
I GBL="PS(50.605," D
.;DBIA #2574
. S DRUGCLAS=$$CLASS2^PSNAPIS(IEN)
. S TEXT="Drug class "_$P(DRUGCLAS,U,1)_"-"_$P(DRUGCLAS,U,2)
;
I GBL="PSNDF(50.6," D
.;DBIA #2531
. S TEXT="VA Generic: "_$$VAGN^PSNAPIS(IEN)
Q TEXT
;
PXRMDRUG ;SLC/PKR - Handle drug findings. ;12/15/2010
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,18**;Feb 04, 2005;Build 152
+2 ;DBIA #5187 for PSSCLINR
+3 ;
+4 ;===============================================
DEVAL(DFN,FINDPA,DEFARR,FINDING,RXTYL,DRUG,POI,FIEVAL) ;Evaluate a drug
+1 ;finding.
+2 IF DRUG=0
IF POI=0
SET FIEVAL=0
QUIT
+3 NEW DTERM,FIEVT
+4 ;Create the pseudo term.
+5 SET DTERM(0)="DTERM"
SET DTERM("IEN")=0
+6 IF $DATA(RXTYL("I"))
IF DRUG>0
Begin DoDot:1
+7 MERGE DTERM(20,1)=DEFARR(20,FINDING)
+8 SET $PIECE(DTERM(20,1,0),U,1)=DRUG_";PS(55,"
+9 SET DTERM("E","PS(55,",DRUG,1)=""
End DoDot:1
+10 IF $DATA(RXTYL("O"))
IF DRUG>0
Begin DoDot:1
+11 MERGE DTERM(20,3)=DEFARR(20,FINDING)
+12 SET $PIECE(DTERM(20,3,0),U,1)=DRUG_";PSRX("
+13 SET DTERM("E","PSRX(",DRUG,3)=""
End DoDot:1
+14 IF $DATA(RXTYL("N"))
IF POI>0
Begin DoDot:1
+15 MERGE DTERM(20,2)=DEFARR(20,FINDING)
+16 SET $PIECE(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
+17 SET DTERM("E","PS(55NVA,",POI,2)=""
End DoDot:1
+18 KILL FIEVT
+19 DO IEVALTER^PXRMTERM(DFN,.FINDPA,.DTERM,1,.FIEVT)
+20 MERGE FIEVAL=FIEVT(1)
+21 IF FIEVAL
SET FIEVAL("FINDING")=DRUG_";PSDRUG("
SET FIEVAL("DISPENSE DRUG")=DRUG
+22 QUIT
+23 ;
+24 ;===============================================
EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate drug findings.
+1 NEW DRUGIEN,DTERM,FIEVT,FINDPA,FINDING
+2 NEW NOINDEX,POI,RXTYL
+3 SET NOINDEX=0
+4 IF $GET(^PXRMINDX(52,"DATE BUILT"))=""
Begin DoDot:1
+5 DO NOINDEX^PXRMERRH("D",PXRMITEM,52)
+6 SET NOINDEX=1
End DoDot:1
+7 IF $GET(^PXRMINDX(55,"DATE BUILT"))=""
Begin DoDot:1
+8 DO NOINDEX^PXRMERRH("D",PXRMITEM,55)
+9 SET NOINDEX=1
End DoDot:1
+10 SET DRUGIEN=""
+11 FOR
SET DRUGIEN=$ORDER(DEFARR("E",ENODE,DRUGIEN))
IF +DRUGIEN=0
QUIT
Begin DoDot:1
+12 SET POI=$$ITEM^PSSCLINR(DRUGIEN)
+13 SET FINDING=""
+14 FOR
SET FINDING=$ORDER(DEFARR("E",ENODE,DRUGIEN,FINDING))
IF +FINDING=0
QUIT
Begin DoDot:2
+15 IF NOINDEX
SET FIEVAL(FINDING)=0
QUIT
+16 MERGE FINDPA=DEFARR(20,FINDING)
+17 KILL FIEVT,RXTYL
+18 ;Determine where we search.
+19 DO SRXTYL^PXRMRXTY(FINDPA(0),.RXTYL)
+20 DO DEVAL(DFN,.FINDPA,.DEFARR,FINDING,.RXTYL,DRUGIEN,POI,.FIEVT)
+21 MERGE FIEVAL(FINDING)=FIEVT
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;===============================================
EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate drug terms for
+1 ;building patient lists.
+2 NEW BDT,EDT,DATE,DFN,DRUGIEN,ITEM,FILENUM,IND,LIST,NFOUND,NOCC,NOINDEX
+3 NEW PFINDPA,POI,RXTYL,TEMP,TF,TFINDPA,TFINDING,TGLIST,TLIST
+4 SET NOINDEX=0
+5 IF $GET(^PXRMINDX(52,"DATE BUILT"))=""
Begin DoDot:1
+6 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
+7 SET NOINDEX=1
End DoDot:1
+8 IF $GET(^PXRMINDX(55,"DATE BUILT"))=""
Begin DoDot:1
+9 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
+10 SET NOINDEX=1
End DoDot:1
+11 IF NOINDEX
QUIT
+12 SET TGLIST="EVALPL_PXRMDRUG"
+13 KILL ^TMP($JOB,TGLIST)
+14 SET DRUGIEN=""
+15 FOR
SET DRUGIEN=$ORDER(TERMARR("E",ENODE,DRUGIEN))
IF +DRUGIEN=0
QUIT
Begin DoDot:1
+16 SET POI=$$ITEM^PSSCLINR(DRUGIEN)
+17 SET TFINDING=""
+18 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,DRUGIEN,TFINDING))
IF +TFINDING=0
QUIT
Begin DoDot:2
+19 KILL PFINDPA,TFINDPA
+20 MERGE TFINDPA=TERMARR(20,TFINDING)
+21 ;Set the finding parameters.
+22 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+23 ;Determine where we search.
+24 DO SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
+25 IF $DATA(RXTYL("I"))
DO GPLIST^PXRMINDL(55,"IP",DRUGIEN,.PFINDPA,TGLIST)
+26 IF $DATA(RXTYL("N"))
IF POI'=""
DO GPLIST^PXRMINDL("55NVA","IP",POI,.PFINDPA,TGLIST)
+27 IF $DATA(RXTYL("O"))
DO GPLIST^PXRMINDL(52,"IP",DRUGIEN,.PFINDPA,TGLIST)
End DoDot:2
End DoDot:1
+28 ;Return the NOCC most recent results for each DFN.
+29 SET NOCC=$PIECE(FINDPA(0),U,14)
+30 SET NOCC=$SELECT(NOCC<0:-NOCC,NOCC="":1,1:NOCC)
+31 FOR TF=0,1
Begin DoDot:1
+32 SET DFN=0
+33 FOR
SET DFN=$ORDER(^TMP($JOB,TGLIST,TF,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+34 KILL TLIST
+35 SET ITEM=""
+36 FOR
SET ITEM=$ORDER(^TMP($JOB,TGLIST,TF,DFN,ITEM))
IF ITEM=""
QUIT
Begin DoDot:3
+37 SET NFOUND=""
+38 FOR
SET NFOUND=$ORDER(^TMP($JOB,TGLIST,TF,DFN,ITEM,NFOUND))
IF NFOUND=""
QUIT
Begin DoDot:4
+39 SET FILENUM=""
+40 FOR
SET FILENUM=$ORDER(^TMP($JOB,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM))
IF FILENUM=""
QUIT
Begin DoDot:5
+41 SET TEMP=^TMP($JOB,TGLIST,TF,DFN,ITEM,NFOUND,FILENUM)
+42 SET DATE=+$PIECE(TEMP,U,3)
+43 SET TLIST(TF,DATE,ITEM,NFOUND,FILENUM)=""
End DoDot:5
End DoDot:4
End DoDot:3
+44 SET DATE=""
SET NFOUND=0
+45 FOR
SET DATE=$ORDER(TLIST(TF,DATE),-1)
IF (DATE="")!(NFOUND=NOCC)
QUIT
Begin DoDot:3
+46 SET ITEM=""
+47 FOR
SET ITEM=$ORDER(TLIST(TF,DATE,ITEM))
IF (ITEM="")!(NFOUND=NOCC)
QUIT
Begin DoDot:4
+48 SET IND=""
+49 FOR
SET IND=$ORDER(TLIST(TF,DATE,ITEM,IND))
IF (IND="")!(NFOUND=NOCC)
QUIT
Begin DoDot:5
+50 SET FILENUM=""
+51 FOR
SET FILENUM=$ORDER(TLIST(TF,DATE,ITEM,IND,FILENUM))
IF (FILENUM="")!(NFOUND=NOCC)
QUIT
Begin DoDot:6
+52 SET NFOUND=NFOUND+1
+53 SET ^TMP($JOB,PLIST,TF,DFN,ITEM,NFOUND,FILENUM)=^TMP($JOB,TGLIST,TF,DFN,ITEM,IND,FILENUM)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+54 KILL ^TMP($JOB,TGLIST)
+55 QUIT
+56 ;
+57 ;===============================================
EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate drug terms.
+1 NEW DATEORDR,DRUGIEN,DTERM,DTFIEVAL,IND,JND,NOINDEX,PFINDPA,POI
+2 NEW RXTYL,TEMP,TFINDING,TFINDPA
+3 NEW DATEORDR,NOCC,SDIR
+4 SET NOINDEX=0
+5 IF $GET(^PXRMINDX(52,"DATE BUILT"))=""
Begin DoDot:1
+6 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),52)
+7 SET NOINDEX=1
End DoDot:1
+8 IF $GET(^PXRMINDX(55,"DATE BUILT"))=""
Begin DoDot:1
+9 DO NOINDEX^PXRMERRH("TR",TERMARR("IEN"),55)
+10 SET NOINDEX=1
End DoDot:1
+11 ;Set NOCC and SDIR.
+12 SET NOCC=$PIECE(FINDPA(0),U,14)
+13 IF NOCC=""
SET NOCC=1
+14 SET SDIR=$SELECT(NOCC<0:+1,1:-1)
+15 SET NOCC=$SELECT(NOCC<0:-NOCC,1:NOCC)
+16 SET DRUGIEN=""
+17 FOR
SET DRUGIEN=$ORDER(TERMARR("E",ENODE,DRUGIEN))
IF +DRUGIEN=0
QUIT
Begin DoDot:1
+18 SET POI=$$ITEM^PSSCLINR(DRUGIEN)
+19 SET TFINDING=""
+20 FOR
SET TFINDING=$ORDER(TERMARR("E",ENODE,DRUGIEN,TFINDING))
IF +TFINDING=0
QUIT
Begin DoDot:2
+21 SET TFIEVAL(TFINDING)=0
+22 IF NOINDEX
QUIT
+23 KILL DTERM,DTFIEVAL,PFINDPA,TFINDPA
+24 SET DTERM(0)="DTERM"
SET DTERM("IEN")=0
+25 MERGE TFINDPA=TERMARR(20,TFINDING)
+26 ;Set the finding parameters.
+27 DO SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
+28 ;Determine where we search.
+29 DO SRXTYL^PXRMRXTY(PFINDPA(0),.RXTYL)
+30 IF $DATA(RXTYL("I"))
Begin DoDot:3
+31 MERGE DTERM(20,1)=TERMARR(20,TFINDING)
+32 SET $PIECE(DTERM(20,1,0),U,1)=DRUGIEN_";PS(55,"
+33 SET DTERM("E","PS(55,",DRUGIEN,1)=""
End DoDot:3
+34 IF $DATA(RXTYL("N"))
IF POI'=""
Begin DoDot:3
+35 MERGE DTERM(20,2)=TERMARR(20,TFINDING)
+36 SET $PIECE(DTERM(20,2,0),U,1)=POI_";PS(55NVA,"
+37 SET DTERM("E","PS(55NVA,",POI,2)=""
End DoDot:3
+38 IF $DATA(RXTYL("O"))
Begin DoDot:3
+39 MERGE DTERM(20,3)=TERMARR(20,TFINDING)
+40 SET $PIECE(DTERM(20,3,0),U,1)=DRUGIEN_";PSRX("
+41 SET DTERM("E","PSRX(",DRUGIEN,3)=""
End DoDot:3
+42 DO IEVALTER^PXRMTERM(DFN,.PFINDPA,.DTERM,TFINDING,.DTFIEVAL)
+43 DO DORDER^PXRMTERM(.DTFIEVAL,.DATEORDR)
+44 DO COPY^PXRMTERM(NOCC,SDIR,.DTFIEVAL,.DATEORDR,TFINDING,.TFIEVAL,0)
+45 ;Save the dispense drug
+46 SET JND=0
+47 FOR
SET JND=+$ORDER(TFIEVAL(TFINDING,JND))
IF JND=0
QUIT
SET TFIEVAL(TFINDING,JND,"DISPENSE DRUG")=DRUGIEN
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
+50 ;===============================================
MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
+1 NEW DRUG,DRUGIEN,IND,FTYPE,NAME,PFIEVAL,TEMP
+2 IF $DATA(IFIEVAL("TERM FINDING"))
SET NLINES=NLINES+1
SET TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
+3 SET DRUGIEN=IFIEVAL("DISPENSE DRUG")
+4 SET DRUG=$$DRUG^PSSCLINR(DRUGIEN)
+5 SET NAME="Drug: "_DRUG_" = "
+6 SET NLINES=NLINES+1
+7 SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
+8 SET IND=0
+9 FOR
SET IND=+$ORDER(IFIEVAL(IND))
IF IND=0
QUIT
Begin DoDot:1
+10 SET TEMP=IFIEVAL(IND,"FINDING")
+11 SET FTYPE=$PIECE(TEMP,";",2)
+12 KILL PFIEVAL
MERGE PFIEVAL=IFIEVAL(IND)
+13 SET PFIEVAL("DISPENSE DRUG")=DRUG
+14 IF FTYPE="PS(55,"
DO MHVOUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
+15 IF FTYPE="PS(55NVA,"
DO MHVOUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
+16 IF FTYPE="PSRX("
DO MHVOUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
End DoDot:1
+17 SET NLINES=NLINES+1
SET TEXT(NLINES)=""
+18 QUIT
+19 ;
+20 ;===============================================
OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
+1 ;maintenance output.
+2 NEW DRUG,FTYPE,IND,PFIEVAL,TEMP,TEXTOUT
+3 IF $DATA(IFIEVAL("TERM FINDING"))
SET NLINES=NLINES+1
SET TEXT(NLINES)=" "_$$CLORGNT(IFIEVAL("TERM FINDING"))
+4 SET DRUG=$$DRUG^PSSCLINR(IFIEVAL("DISPENSE DRUG"))
+5 SET NLINES=NLINES+1
SET TEXT(NLINES)=$$INSCHR^PXRMEXLC(INDENT," ")_"Drug: "_DRUG
+6 SET IND=0
+7 FOR
SET IND=+$ORDER(IFIEVAL(IND))
IF IND=0
QUIT
Begin DoDot:1
+8 SET TEMP=IFIEVAL(IND,"FINDING")
+9 SET FTYPE=$PIECE(TEMP,";",2)
+10 KILL PFIEVAL
MERGE PFIEVAL=IFIEVAL(IND)
+11 SET PFIEVAL("DISPENSE DRUG")=DRUG
+12 IF FTYPE="PS(55,"
DO OUTPUT^PXRMDIN(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
+13 IF FTYPE="PS(55NVA,"
DO OUTPUT^PXRMDNVA(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
+14 IF FTYPE="PSRX("
DO OUTPUT^PXRMDOUT(INDENT+1,.PFIEVAL,.NLINES,.TEXT)
QUIT
End DoDot:1
+15 QUIT
+16 ;
+17 ;===============================================
CLORGNT(FINDING) ;Generate drug class or VA Generic text.
+1 NEW DRUGCLAS,IEN,GBL,TEXT
+2 SET TEXT=""
+3 SET IEN=$PIECE(FINDING,";",1)
+4 SET GBL=$PIECE(FINDING,";",2)
+5 IF GBL="PS(50.605,"
Begin DoDot:1
+6 ;DBIA #2574
+7 SET DRUGCLAS=$$CLASS2^PSNAPIS(IEN)
+8 SET TEXT="Drug class "_$PIECE(DRUGCLAS,U,1)_"-"_$PIECE(DRUGCLAS,U,2)
End DoDot:1
+9 ;
+10 IF GBL="PSNDF(50.6,"
Begin DoDot:1
+11 ;DBIA #2531
+12 SET TEXT="VA Generic: "_$$VAGN^PSNAPIS(IEN)
End DoDot:1
+13 QUIT TEXT
+14 ;
