- PXRMDRUG ;SLC/PKR - Handle drug findings. ;01/13/2017
- ;;2.0;CLINICAL REMINDERS;**4,6,12,18,47**;Feb 04, 2005;Build 291
- ;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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDRUG 8232 printed Feb 18, 2025@23:10:41 Page 2
- PXRMDRUG ;SLC/PKR - Handle drug findings. ;01/13/2017
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,18,47**;Feb 04, 2005;Build 291
- +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 ;