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

PXRMINDX.m

Go to the documentation of this file.
  1. PXRMINDX ;SLC/PKR - Routines for utilizing the index. ;03/31/2022
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,17,18,26,65**;Feb 04, 2005;Build 438
  1. ;Code for patient findings.
  1. ;====================
  1. EVALFI(DFN,DEFARR,ENODE,FIEVAL) ;General finding evaluator.
  1. N BDT,EDT,FIEVT,FILENUM,FINDING,FINDPA,ITEM,NOINDEX
  1. S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
  1. I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
  1. . D NOINDEX^PXRMERRH("D",PXRMITEM,FILENUM)
  1. . S NOINDEX=1
  1. E S NOINDEX=0
  1. S ITEM=""
  1. F S ITEM=$O(DEFARR("E",ENODE,ITEM)) Q:ITEM="" D
  1. . S FINDING=""
  1. . F S FINDING=$O(DEFARR("E",ENODE,ITEM,FINDING)) Q:+FINDING=0 D
  1. .. I NOINDEX S FIEVAL(FINDING)=0 Q
  1. .. K FINDPA
  1. .. M FINDPA=DEFARR(20,FINDING)
  1. .. K FIEVT
  1. .. D FIEVAL(FILENUM,"PI",DFN,ITEM,.FINDPA,.FIEVT)
  1. .. M FIEVAL(FINDING)=FIEVT
  1. .. S FIEVAL(FINDING,"FINDING")=$P(FINDPA(0),U,1)
  1. .. I FILENUM=9000010.11 D CRFINDING^PXRMIMM(DFN,ITEM,FINDING,.FIEVAL)
  1. Q
  1. ;
  1. ;====================
  1. EVALTERM(DFN,FINDPA,ENODE,TERMARR,TFIEVAL) ;General term
  1. ;evaluator.
  1. N FIEVT,FILENUM,ITEM,NOINDEX,PFINDPA
  1. N TFINDING,TFINDPA
  1. S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
  1. I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D
  1. . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM)
  1. . S NOINDEX=1
  1. E S NOINDEX=0
  1. S ITEM=""
  1. F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:ITEM="" D
  1. . S TFINDING=""
  1. . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
  1. .. I NOINDEX S TFIEVAL(TFINDING)=0 Q
  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(FILENUM,"PI",DFN,ITEM,.PFINDPA,.FIEVT)
  1. .. M TFIEVAL(TFINDING)=FIEVT
  1. .. S TFIEVAL(TFINDING,"FINDING")=$P(TFINDPA(0),U,1)
  1. .. I FILENUM=9000010.11 D CRFINDING^PXRMIMM(DFN,ITEM,TFINDING,.TFIEVAL)
  1. Q
  1. ;
  1. ;====================
  1. FIEVAL(FILENUM,SNODE,DFN,ITEM,PFINDPA,FIEVAL) ;
  1. ;Evaluate regular patient findings.
  1. N BDT,CASESEN,COND,CONVAL,CRLIST,DAS,DATE,EDT,FIEVD,FLIST
  1. N ICOND,IEN,IND,INVFD,ISC,NFOUND,NGET,NOCC,NP
  1. N SAVE,SDIR,SSFIND,STATOK,STATUSA,UCIFS,USESTRT,VSLIST
  1. ;Set the finding search parameters.
  1. D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
  1. S FIEVAL("BDTE")=BDT,FIEVAL("EDTE")=EDT
  1. D SCPAR^PXRMCOND(.PFINDPA,.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. S ISC=$S(FILENUM=9000010.11:$P(PFINDPA(0),U,17),1:"")
  1. ;Determine if this is a finding with a start and stop date.
  1. S SSFIND=$S(FILENUM=52:1,FILENUM["55":1,FILENUM=100:1,1:0)
  1. S USESTRT=$S(SSFIND:$P(PFINDPA(0),U,15),1:0)
  1. I FILENUM=100,USESTRT="" S USESTRT=1
  1. ;Get the status list.
  1. D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
  1. I SSFIND D FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,.NFOUND,.FLIST)
  1. I 'SSFIND D FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST)
  1. I NFOUND=0 S FIEVAL=0 Q
  1. S INVFD=$P(PFINDPA(0),U,16)
  1. S NP=0
  1. F IND=1:1:NFOUND Q:NP=NOCC D
  1. . S DAS=$P(FLIST(IND),U,1)
  1. .;If this a Lab finding attach the item to the DAS.
  1. . I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS
  1. .;If this is a Mental Health finding attach the scale to DAS.
  1. . I PFINDPA(0)["YTT(601.71" S DAS=DAS_"S"_$P(PFINDPA(0),U,12)
  1. . D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
  1. . I INVFD,$D(FIEVD("VISIT")) D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
  1. . S FIEVD("DATE")=$P(FLIST(IND),U,2)
  1. . I ISC'="" S FIEVD("ISC")=ISC
  1. .;If there is a status list make sure the finding has one on the list.
  1. . S STATOK=$S($D(STATUSA):$$STATUSOK(.STATUSA,.FIEVD),1:1)
  1. . I 'STATOK Q
  1. . S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),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")=$P(FLIST(IND),U,1)
  1. .. S FIEVAL(NP,"DATE")=FIEVD("DATE")
  1. .. M FIEVAL(NP)=FIEVD
  1. .. I $G(PXRMDEBG) M FIEVAL(NP,"CSUB")=FIEVD
  1. ;
  1. ;Save the finding result.
  1. D SFRES^PXRMUTIL(SDIR,NP,.FIEVAL)
  1. S FIEVAL("FILE NUMBER")=FILENUM
  1. Q
  1. ;
  1. ;====================
  1. FPDAT(FILENUM,SNODE,ISC,DFN,ITEM,NGET,SDIR,BDT,EDT,NFOUND,FLIST) ;Find patient
  1. ;data for regular files. FLIST is returned in date order, i.e.,
  1. ;FLIST(1) is the most recent SDIR=-1, oldest SDIR=+1.
  1. I (FILENUM=9000010.11),(ISC="CVX") D CVXP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
  1. I (FILENUM=9000010.11),(ISC="VGN") D VGNP^PXRMIMM(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
  1. I FILENUM=601.84 D SEVALFI^PXRMMH(DFN,ITEM,NGET,SDIR,BDT,EDT,.NFOUND,.FLIST) Q
  1. N DAS,DATE,DONE,EDTT
  1. S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1. S (DONE,NFOUND)=0
  1. S DATE=$S(SDIR=+1:BDT-.000001,1:EDTT)
  1. F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE),SDIR) Q:(DATE=0)!(DONE) D
  1. . I DATE<BDT,SDIR=-1 S DONE=1 Q
  1. . I DATE>EDTT,SDIR=1 S DONE=1 Q
  1. . S DAS=""
  1. . F S DAS=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,DATE,DAS),-1) Q:DAS="" D
  1. .. S NFOUND=NFOUND+1
  1. .. S FLIST(NFOUND)=DAS_U_DATE
  1. .. I NFOUND=NGET S DONE=1 Q
  1. Q
  1. ;
  1. ;====================
  1. FPDATSS(FILENUM,SNODE,DFN,ITEM,NGET,SDIR,BDT,EDT,USESTRT,NFOUND,FLIST) ;Find
  1. ;patient data for findings that have a start and stop date. FLIST
  1. ;is returned in date order, i.e., FLIST(1) is the most recent.
  1. N DAS,DONE,EDTT,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST
  1. S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1. S (DONE,NFOUND)=0
  1. S START=$S(SDIR=+1:0,1:EDTT)
  1. F S START=+$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START),SDIR) Q:(START=0)!(DONE)!(START>EDTT) D
  1. . S STOP=""
  1. . F S STOP=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP),SDIR) Q:(STOP="")!(DONE) D
  1. ..;Items that do not have a stop date are flagged by "U".
  1. .. S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP)
  1. .. S OVERLAP=$$OVERLAP(START,SDATE,BDT,EDT)
  1. .. I OVERLAP="O" D
  1. ... S DAS=$O(^PXRMINDX(FILENUM,SNODE,DFN,ITEM,START,STOP,""))
  1. ... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_SDATE
  1. ..;Some orders and non-VA meds may not have a Stop Date so we have
  1. ..;to check all entries.
  1. .. I FILENUM="55NVA" Q
  1. .. I FILENUM=100 Q
  1. .. I OVERLAP="L",SDIR=-1 S DONE=1 Q
  1. .. I OVERLAP="R",SDIR=1 S DONE=1 Q
  1. ;Return up to NGET of the most recent/oldest entries.
  1. S NFOUND=0,TDATE=""
  1. F S TDATE=$O(TLIST(TDATE),SDIR) Q:(TDATE="")!(NFOUND=NGET) D
  1. . S TIND=0
  1. . F S TIND=$O(TLIST(TDATE,TIND)) Q:(TIND="")!(NFOUND=NGET) D
  1. .. S NFOUND=NFOUND+1,FLIST(NFOUND)=TLIST(TDATE,TIND)
  1. Q
  1. ;
  1. ;====================
  1. OVERLAP(START,STOP,BDT,EDT) ;Determine if the date range defined by START and
  1. ;STOP overlaps with the date range defined by BDT and EDT. The return
  1. ;value "O" means they overlap, "L" means START, STOP is to the
  1. ;left of BDT, EDT and "R" means it is to the right.
  1. I EDT<START Q "R"
  1. I STOP<BDT Q "L"
  1. Q "O"
  1. ;
  1. ;====================
  1. STATUSOK(STATUSA,FIEVD) ;Return true if the status in FIEVD matches one in
  1. ;the list in STATUSA.
  1. I '$D(FIEVD("STATUS")) Q 1
  1. N JND,OK
  1. S OK=0
  1. F JND=1:1:STATUSA(0) Q:OK D
  1. . I STATUSA(JND)="*" S OK=1 Q
  1. . I STATUSA(JND)=FIEVD("STATUS") S OK=1 Q
  1. Q OK
  1. ;