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. ;