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

PXRMTAX.m

Go to the documentation of this file. 
  1. PXRMTAX ;SLC/PKR - Handle taxonomy finding. ;12/09/2020
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12,18,24,26,42**;Feb 04, 2005;Build 245
  1.  ;
  1.  ;==================================================
  1. EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;Evaluate taxonomy findings.
  1.  N FIEVT,FINDPA,FINDING
  1.  N TAXIEN
  1.  S TAXIEN=""
  1.  F  S TAXIEN=$O(DEFARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
  1.  . S FINDING=""
  1.  . F  S FINDING=$O(DEFARR("E",ENODE,TAXIEN,FINDING)) Q:+FINDING=0  D
  1.  .. K FINDPA
  1.  .. M FINDPA=DEFARR(20,FINDING)
  1.  .. K FIEVT
  1.  .. D FIEVAL(DFN,TAXIEN,.FINDPA,.FIEVT)
  1.  .. M FIEVAL(FINDING)=FIEVT
  1.  Q
  1.  ;
  1.  ;==================================================
  1. EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate taxonomy terms for
  1.  ;building patient lists.
  1.  N PFIND3,PFIND4,PFINDPA,TAXIEN
  1.  N TFINDPA,TFINDING
  1.  S TAXIEN=""
  1.  F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
  1.  . S TFINDING=""
  1.  . F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
  1.  .. K PFINDPA,TFINDPA
  1.  .. M TFINDPA=TERMARR(20,TFINDING)
  1.  ..;Set the finding parameters.
  1.  .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1.  .. D GPLIST(TAXIEN,.PFINDPA,PLIST)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;Evaluate taxonomy
  1.  ;terms.
  1.  N FIEVT,PFINDPA
  1.  N TAXIEN,TFINDPA,TFINDING
  1.  S TAXIEN=""
  1.  F  S TAXIEN=$O(TERMARR("E",ENODE,TAXIEN)) Q:+TAXIEN=0  D
  1.  . S TFINDING=""
  1.  . F  S TFINDING=$O(TERMARR("E",ENODE,TAXIEN,TFINDING)) Q:+TFINDING=0  D
  1.  .. K FIEVT,PFINDPA,TFINDPA
  1.  .. M TFINDPA=TERMARR(20,TFINDING)
  1.  ..;Set the finding parameters.
  1.  .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1.  .. D FIEVAL(DFN,TAXIEN,.PFINDPA,.FIEVT)
  1.  .. M TFIEVAL(TFINDING)=FIEVT
  1.  Q
  1.  ;
  1.  ;==================================================
  1. FIEVAL(DFN,TAXIEN,FINDPA,FIEVAL) ;
  1.  N BDT,CASESEN,CODE,CODESYS,COND,CONVAL,DAS,DATE,EDT,ENS
  1.  N FIEVT,FILENUM,FLIST,ICOND,INCVD,IND,INS
  1.  N NFOUND,NGET,NOCC,NP,PLS
  1.  N RAS,SAVE,SDIR,STATUSA,TAXARR,TLIST,UCIFS,USEINP,VSLIST
  1.  ;Set the finding search parameters.
  1.  D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
  1.  I $G(PXRMDEBG) S FIEVAL("BDTE")=BDT,FIEVAL("EDTE")=EDT
  1.  S INCVD=$P(FINDPA(0),U,16)
  1.  D TAX^PXRMLDR(TAXIEN,.TAXARR)
  1.  D SCPAR^PXRMCOND(.FINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
  1.  S SDIR=$S(NOCC<0:+1,1:-1)
  1.  S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1.  S NGET=$S(UCIFS:50,1:NOCC)
  1.  ;
  1.  ;Each TLIST entry returned by the FPDAT entry points should be:
  1.  ;DAS^DATE^CODESYS^CODE^NODE
  1.  ;
  1.  I TAXARR("APDS",45,"NNODES")>0 D FPDAT^PXRMDGPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
  1.  ;
  1.  I TAXARR("APDS",9000010.07,"NNODES")>0 D FPDAT^PXRMVPOV(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
  1.  ;
  1.  I TAXARR("APDS",9000011,"NNODES")>0 D
  1.  . K STATUSA
  1.  . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
  1.  . D FPDAT^PXRMPROB(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.STATUSA,.TLIST)
  1.  ;
  1.  I (TAXARR("APDS",9000010.18,"NNODES")>0) D FPDAT^PXRMVCPT(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
  1.  ;
  1.  I (TAXARR("APDS",9000010.71,"NNODES")>0) D FPDAT^PXRMVSC(DFN,.TAXARR,NGET,SDIR,BDT,EDT,.TLIST)
  1.  ;
  1.  I (TAXARR("APDS",71,"NNODES")>0) D
  1.  . K STATUSA
  1.  . D GETSTATI^PXRMSTAT(70,.FINDPA,.STATUSA)
  1.  . D FPDAT^PXRMRCPT(DFN,.TAXARR,NOCC,BDT,EDT,.STATUSA,.TLIST)
  1.  ;
  1.  ;Process the found list, returning up to NOCC date ordered results.
  1.  S DATE="",NFOUND=0
  1.  F  S DATE=$O(TLIST(DATE),SDIR) Q:(DATE="")!(NFOUND=NOCC)  D
  1.  . S IND=0
  1.  . F  S IND=$O(TLIST(DATE,IND)) Q:(IND="")!(NFOUND=NOCC)  D
  1.  .. S FILENUM=0
  1.  .. F  S FILENUM=$O(TLIST(DATE,IND,FILENUM)) Q:FILENUM=""  D
  1.  ... S NFOUND=NFOUND+1
  1.  ... S FLIST(NFOUND)=FILENUM_U_TLIST(DATE,IND,FILENUM)
  1.  I NFOUND=0 S FIEVAL=0 Q
  1.  S NP=0
  1.  F IND=1:1:NFOUND Q:NP=NOCC  D
  1.  . S FILENUM=$P(FLIST(IND),U,1)
  1.  . S DAS=$P(FLIST(IND),U,2)
  1.  . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
  1.  . I INCVD,$D(FIEVT("VISIT")) D GETDATA^PXRMVSIT(FIEVT("VISIT"),.FIEVT,0)
  1.  . S FIEVT("DATE")=$P(FLIST(IND),U,3)
  1.  . S FIEVT("CODESYS")=$P(FLIST(IND),U,4)
  1.  . S FIEVT("CODE")=$P(FLIST(IND),U,5)
  1.  . S FIEVT("NODE")=$P(FLIST(IND),U,6)
  1.  . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVT),1:1)
  1.  . S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
  1.  . I SAVE D
  1.  .. S NP=NP+1
  1.  .. S FIEVAL(NP)=CONVAL
  1.  .. I COND'="" S FIEVAL(NP,"CONDITION")=CONVAL
  1.  .. S FIEVAL(NP,"DAS")=DAS
  1.  .. S FIEVAL(NP,"DATE")=FIEVT("DATE")
  1.  .. S FIEVAL(NP,"FILE NUMBER")=FILENUM
  1.  .. S FIEVAL(NP,"FILE SPECIFIC")=$P(FLIST(IND),U,6,10)
  1.  .. S FIEVAL(NP,"FINDING")=TAXIEN_";PXD(811.2,"
  1.  .. M FIEVAL(NP)=FIEVT
  1.  .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVT
  1.  ;Save the finding result.
  1.  D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. GPLIST(TAXIEN,FINDPA,PLIST) ;Get the list of patients with
  1.  ;taxonomy TAXIEN. Return the list as:
  1.  ; ^TMP($J,PLIST,T/F,DFN,TAXIEN,COUNT,FILE NUMBER)
  1.  ; =DAS^DATE^CODE^TYPE^file specific. TAXIEN is like the item for
  1.  ;non-taxonomy findings.
  1.  N BDT,COND,DATE,DFN,DLIST,EDT,ENS,FILENUM
  1.  N ICOND,IND,INS,IPLIST
  1.  N NF,NFOUND,NF,NGET,NOCC
  1.  N PLS,RAS,STATUSA,UCIFS,USEINP,TAXARR,TF,TLIST,VSLIST
  1.  ;Set the finding search parameters.
  1.  S TLIST="GPLIST_PXRMTAX"
  1.  K ^TMP($J,TLIST)
  1.  D SSPAR^PXRMUTIL(FINDPA(0),.NOCC,.BDT,.EDT)
  1.  D TAX^PXRMLDR(TAXIEN,.TAXARR)
  1.  D SCPAR^PXRMCOND(.FINDPA,.COND,.UCIFS,.ICOND,.VSLIST)
  1.  ;
  1.  ;Each TLIST entry returned by the GPLIST entry points should be:
  1.  ;DAS^DATE^CODESYS^CODE^NODE
  1.  ;
  1.  I TAXARR("APDS",45,"NNODES")>0 D GPLIST^PXRMDGPT(.TAXARR,NOCC,BDT,EDT,TLIST)
  1.  ;
  1.  I TAXARR("APDS",9000011,"NNODES")>0 D 
  1.  . K STATUSA
  1.  . D GETSTATI^PXRMSTAT(9000011,.FINDPA,.STATUSA)
  1.  . D GPLIST^PXRMPROB(.TAXARR,NOCC,BDT,EDT,.STATUSA,TLIST)
  1.  ;
  1.  I (TAXARR("APDS",9000010.07,"NNODES")>0) D GPLIST^PXRMVPOV(.TAXARR,NOCC,BDT,EDT,TLIST)
  1.  ;
  1.  I (TAXARR("APDS",9000010.18,"NNODES")>0) D GPLIST^PXRMVCPT(.TAXARR,NOCC,BDT,EDT,TLIST)
  1.  ;
  1.  I (TAXARR("APDS",9000010.71,"NNODES")>0) D GPLIST^PXRMVSC(.TAXARR,NOCC,BDT,EDT,TLIST)
  1.  ;
  1.  I (TAXARR("APDS",71,"NNODES")>0) D GPLIST^PXRMRCPT(.TAXARR,.FINDPA,TLIST)
  1.  ;Conditions for taxonomies only apply to radiology findings, this
  1.  ;is taken care of in PXRMRCPT.
  1.  ;
  1.  ;Process the found list, return up to NOCC of the most recent entries.
  1.  F TF=0,1 D
  1.  . I '$D(^TMP($J,TLIST,TF)) Q
  1.  . S DFN=""
  1.  . F  S DFN=$O(^TMP($J,TLIST,TF,DFN)) Q:DFN=""  D
  1.  .. K DLIST,IPLIST
  1.  .. S NFOUND=0
  1.  .. S NF=""
  1.  .. F  S NF=$O(^TMP($J,TLIST,TF,DFN,NF),-1) Q:NF=""  D
  1.  ... S FILENUM=0
  1.  ... F  S FILENUM=$O(^TMP($J,TLIST,TF,DFN,NF,FILENUM)) Q:FILENUM=""  D
  1.  .... S NFOUND=NFOUND+1
  1.  .... S DATE=$P(^TMP($J,TLIST,TF,DFN,NF,FILENUM),U,2)
  1.  .... S DLIST(DATE,NFOUND)=NF_U_FILENUM
  1.  ..;
  1.  .. S DATE="",NFOUND=0
  1.  .. F  S DATE=$O(DLIST(DATE),-1) Q:(DATE="")!(NFOUND=NOCC)  D
  1.  ... S NF=0
  1.  ... F  S NF=$O(DLIST(DATE,NF)) Q:(NF="")!(NFOUND=NOCC)  D
  1.  .... S NFOUND=NFOUND+1
  1.  .... S IND=$P(DLIST(DATE,NF),U,1)
  1.  .... S FILENUM=$P(DLIST(DATE,NF),U,2)
  1.  .... S IPLIST(TF,DFN,TAXIEN,NFOUND,FILENUM)=^TMP($J,TLIST,TF,DFN,IND,FILENUM)
  1.  .. M ^TMP($J,PLIST)=IPLIST
  1.  K ^TMP($J,TLIST)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
  1.  N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
  1.  S IND=0
  1.  F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
  1.  S FILENUM=""
  1.  F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
  1.  . K OCCLIST
  1.  . M OCCLIST=FNA(FILENUM)
  1.  . I FILENUM=45 D MHVOUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=70 D MHVOUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.07 D MHVOUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.18 D MHVOUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.71 D MHVOUT^PXRMVSC(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000011 D MHVOUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
  1.  Q
  1.  ;
  1.  ;==================================================
  1. OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
  1.  ;maintenance output.
  1.  N IND,FILENUM,FNA,OCCLIST,TIFIEVAL
  1.  S IND=0
  1.  F  S IND=+$O(IFIEVAL(IND)) Q:IND=0  S FILENUM=IFIEVAL(IND,"FILE NUMBER"),FNA(FILENUM,IND)=""
  1.  S FILENUM=""
  1.  F  S FILENUM=$O(FNA(FILENUM)) Q:FILENUM=""  D
  1.  . K OCCLIST
  1.  . M OCCLIST=FNA(FILENUM)
  1.  . I FILENUM=45 D OUTPUT^PXRMDGPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=70 D OUTPUT^PXRMRCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.07 D OUTPUT^PXRMVPOV(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.18 D OUTPUT^PXRMVCPT(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000010.71 D OUTPUT^PXRMVSC(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT) Q
  1.  . I FILENUM=9000011 D OUTPUT^PXRMPROB(INDENT,.OCCLIST,.IFIEVAL,.NLINES,.TEXT)
  1.  Q
  1.  ;