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

PXRMINDL.m

Go to the documentation of this file.
  1. PXRMINDL ; SLC/PKR - List building routines. ;01/06/2019
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,26,65**;Feb 04, 2005;Build 438
  1. ;================================================
  1. EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;General patient list term evaluator.
  1. ;Return the list in ^TMP($J,PLIST)
  1. N ITEM,FILENUM,PFINDPA
  1. N SSFIND,TEMP,TFINDING,TFINDPA
  1. S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
  1. I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D Q
  1. . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM)
  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. .. K PFINDPA,TFINDPA
  1. .. M TFINDPA=TERMARR(20,TFINDING)
  1. ..;Set the finding parameters.
  1. .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
  1. .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST)
  1. Q
  1. ;
  1. ;================================================
  1. FPLIST(FILENUM,SNODE,ISC,ITEM,NOCC,BDT,EDT,PLIST) ;Find patient list data for
  1. ;regular files. Return the list in ^TMP($J,PLIST).
  1. N DAS,DATE,DFN,DS,NFOUND
  1. K ^TMP($J,PLIST)
  1. I (FILENUM=9000010.11),(ISC'="") D Q
  1. . I ISC="CVX" D CVXL^PXRMIMM(ITEM,NOCC,BDT,EDT,PLIST) Q
  1. . I ISC="VGN" D VGNL^PXRMIMM(ITEM,NOCC,BDT,EDT,PLIST)
  1. I FILENUM=601.84 D SEVALPL^PXRMMH(ITEM,NOCC,BDT,EDT,PLIST) Q
  1. S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1. S DFN=0
  1. F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D
  1. . S NFOUND=0
  1. . S DATE=DS
  1. . F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)!(NFOUND=NOCC) D
  1. .. S DAS=""
  1. .. F S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE,DAS),-1) Q:DAS="" D
  1. ... S NFOUND=NFOUND+1
  1. ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE
  1. Q
  1. ;
  1. ;================================================
  1. FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,PLIST) ;Find patient list
  1. ;data for a finding with a start and stop date.
  1. ;Return the list in ^TMP($J,PLIST).
  1. N DAS,DFN,DONE,EDTT,NFOUND,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST
  1. K ^TMP($J,PLIST)
  1. S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
  1. S DFN=0
  1. F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D
  1. . S (DONE,NFOUND)=0
  1. . S START=EDTT
  1. . K TLIST
  1. . F S START=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START),-1) Q:(START=0)!(DONE) D
  1. .. S STOP=""
  1. .. F S STOP=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP),-1) Q:(STOP="")!(DONE) D
  1. ... S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP)
  1. ... S OVERLAP=$$OVERLAP^PXRMINDX(START,SDATE,BDT,EDTT)
  1. ... I OVERLAP="O" D
  1. .... S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP,""))
  1. .... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_START_U_SDATE
  1. ... I FILENUM="55NVA" Q
  1. ... I FILENUM=100 Q
  1. ... I OVERLAP="L" S DONE=1 Q
  1. .;Return up to NGET of the most recent entries.
  1. . S NFOUND=0,TDATE=""
  1. . F S TDATE=$O(TLIST(TDATE)) 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,^TMP($J,PLIST,DFN,NFOUND)=TLIST(TDATE,TIND)
  1. Q
  1. ;
  1. ;================================================
  1. GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list
  1. ;for a regular file. Return the list in ^TMP($J,PLIST):
  1. ;^TMP($J,PLIST,T/F,DFN,ITEM,COUNT,FILENUM)=DAS^DATE^VALUE
  1. N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST,GPLIST
  1. N ICOND,IND,INVFD,IPLIST,ISC,NOCC,NFOUND,NGET
  1. N SAVE,SSFIND,STATOK,STATUSA,TEMP,TGLIST,TPLIST
  1. N UCIFS,USESTRT,VALUE,VSLIST
  1. S TGLIST="GPLIST_PXRMINDL"
  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. ;Set the finding search parameters.
  1. D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
  1. S INVFD=$P(PFINDPA(0),U,16)
  1. D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
  1. D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
  1. ;Ignore any negative occurrence counts, date reversal not allowed
  1. ;in patient lists.
  1. S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
  1. S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
  1. I SSFIND D FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,TGLIST)
  1. I 'SSFIND D FPLIST(FILENUM,SNODE,ISC,ITEM,NGET,BDT,EDT,TGLIST)
  1. S DFN=""
  1. F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
  1. . K GPLIST
  1. . M GPLIST=^TMP($J,TGLIST,DFN)
  1. . S (IND,NFOUND)=0
  1. . K IPLIST
  1. . F S IND=$O(GPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D
  1. .. S TEMP=GPLIST(IND)
  1. .. S DAS=$P(TEMP,U,1)
  1. .. S DATE=$P(TEMP,U,2)
  1. ..;If this a Lab finding attach the item to the DAS.
  1. ..;THIS LOOKS LIKE A BUG SINCE ITEM DOES NOT APPEAR TO BE DEFINED BREAK
  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. .. S VALUE=$G(FIEVD("VALUE"))
  1. .. I INVFD,$D(FIEVD("VISIT")) D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
  1. .. S FIEVD("DATE")=DATE
  1. ..;If there is a status list make sure the finding has a status on
  1. ..;the list.
  1. .. S STATOK=$S($D(STATUSA):$$STATUSOK^PXRMINDX(.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 NFOUND=NFOUND+1
  1. ... S IPLIST(CONVAL,DFN,ITEM,NFOUND,FILENUM)=TEMP_U_VALUE
  1. . M ^TMP($J,PLIST)=IPLIST
  1. K ^TMP($J,TGLIST)
  1. Q
  1. ;