[623] | 1 | PXRMINDL ; SLC/PKR - List building routines. ;07/17/2006
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
|
---|
| 3 | ;================================================
|
---|
| 4 | EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;General patient list term evaluator.
|
---|
| 5 | ;Return the list in ^TMP($J,PLIST)
|
---|
| 6 | N ITEM,FILENUM,PFINDPA
|
---|
| 7 | N SSFIND,TEMP,TFINDING,TFINDPA
|
---|
| 8 | S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
|
---|
| 9 | I $G(^PXRMINDX(FILENUM,"DATE BUILT"))="" D Q
|
---|
| 10 | . D NOINDEX^PXRMERRH("TR",TERMARR("IEN"),FILENUM)
|
---|
| 11 | S ITEM=""
|
---|
| 12 | F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:ITEM="" D
|
---|
| 13 | . S TFINDING=""
|
---|
| 14 | . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
|
---|
| 15 | .. K PFINDPA,TFINDPA
|
---|
| 16 | .. M TFINDPA=TERMARR(20,TFINDING)
|
---|
| 17 | ..;Set the finding parameters.
|
---|
| 18 | .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
|
---|
| 19 | .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST)
|
---|
| 20 | Q
|
---|
| 21 | ;
|
---|
| 22 | ;================================================
|
---|
| 23 | FPLIST(FILENUM,SNODE,ITEM,NOCC,BDT,EDT,PLIST) ;Find patient list data for
|
---|
| 24 | ;regular files. Return the list in ^TMP($J,PLIST).
|
---|
| 25 | N DAS,DATE,DFN,DS,NFOUND
|
---|
| 26 | K ^TMP($J,PLIST)
|
---|
| 27 | I FILENUM=601.2 D SEVALPL^PXRMMH(ITEM,NOCC,BDT,EDT,PLIST) Q
|
---|
| 28 | S DS=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
|
---|
| 29 | S DFN=0
|
---|
| 30 | F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D
|
---|
| 31 | . S NFOUND=0
|
---|
| 32 | . S DATE=DS
|
---|
| 33 | . F S DATE=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE),-1) Q:(DATE=0)!(DATE<BDT)!(NFOUND=NOCC) D
|
---|
| 34 | .. S NFOUND=NFOUND+1
|
---|
| 35 | .. S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,DATE,""))
|
---|
| 36 | .. S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_DATE
|
---|
| 37 | Q
|
---|
| 38 | ;
|
---|
| 39 | ;================================================
|
---|
| 40 | FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,PLIST) ;Find patient list
|
---|
| 41 | ;data for a finding with a start and stop date.
|
---|
| 42 | ;Return the list in ^TMP($J,PLIST).
|
---|
| 43 | N DAS,DFN,DONE,EDTT,NFOUND,OVERLAP,SDATE,START,STOP,TDATE,TIND,TLIST
|
---|
| 44 | K ^TMP($J,PLIST)
|
---|
| 45 | S EDTT=$S(EDT[".":EDT+.0000001,1:EDT+.240001)
|
---|
| 46 | S DFN=0
|
---|
| 47 | F S DFN=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN)) Q:DFN="" D
|
---|
| 48 | . S (DONE,NFOUND)=0
|
---|
| 49 | . S START=EDTT
|
---|
| 50 | . K TLIST
|
---|
| 51 | . F S START=+$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START),-1) Q:(START=0)!(DONE) D
|
---|
| 52 | .. S STOP=""
|
---|
| 53 | .. F S STOP=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP),-1) Q:(STOP="")!(DONE) D
|
---|
| 54 | ... S SDATE=$S(USESTRT:START,STOP["U":$$NOW^PXRMDATE_"U",1:STOP)
|
---|
| 55 | ... S OVERLAP=$$OVERLAP^PXRMINDX(START,SDATE,BDT,EDTT)
|
---|
| 56 | ... I OVERLAP="O" D
|
---|
| 57 | .... S DAS=$O(^PXRMINDX(FILENUM,SNODE,ITEM,DFN,START,STOP,""))
|
---|
| 58 | .... S NFOUND=NFOUND+1,TLIST(SDATE,NFOUND)=DAS_U_START_U_SDATE
|
---|
| 59 | ... I FILENUM="55NVA" Q
|
---|
| 60 | ... I FILENUM=100 Q
|
---|
| 61 | ... I OVERLAP="L" S DONE=1 Q
|
---|
| 62 | .;Return up to NGET of the most recent entries.
|
---|
| 63 | . S NFOUND=0,TDATE=""
|
---|
| 64 | . F S TDATE=$O(TLIST(TDATE)) Q:(TDATE="")!(NFOUND=NGET) D
|
---|
| 65 | .. S TIND=0
|
---|
| 66 | .. F S TIND=$O(TLIST(TDATE,TIND)) Q:(TIND="")!(NFOUND=NGET) D
|
---|
| 67 | ... S NFOUND=NFOUND+1,^TMP($J,PLIST,DFN,NFOUND)=TLIST(TDATE,TIND)
|
---|
| 68 | Q
|
---|
| 69 | ;
|
---|
| 70 | ;================================================
|
---|
| 71 | GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list
|
---|
| 72 | ;for a regular file. Return the list in ^TMP($J,PLIST):
|
---|
| 73 | ;^TMP($J,PLIST,T/F,DFN,ITEM,COUNT,FILENUM)=DAS^DATE^VALUE
|
---|
| 74 | N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST,GPLIST
|
---|
| 75 | N ICOND,IND,INVFD,IPLIST,NOCC,NFOUND,NGET
|
---|
| 76 | N SAVE,SSFIND,STATOK,STATUSA,TEMP,TGLIST,TPLIST
|
---|
| 77 | N UCIFS,USESTRT,VALUE,VSLIST
|
---|
| 78 | S TGLIST="GPLIST_PXRMINDL"
|
---|
| 79 | ;Determine if this is a finding with a start and stop date.
|
---|
| 80 | S SSFIND=$S(FILENUM=52:1,FILENUM[55:1,FILENUM=100:1,1:0)
|
---|
| 81 | S USESTRT=$S(SSFIND:$P(PFINDPA(0),U,15),1:0)
|
---|
| 82 | I FILENUM=100,USESTRT="" S USESTRT=1
|
---|
| 83 | ;Set the finding search parameters.
|
---|
| 84 | D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
|
---|
| 85 | S INVFD=$P(PFINDPA(0),U,16)
|
---|
| 86 | S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
|
---|
| 87 | D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
|
---|
| 88 | D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
|
---|
| 89 | S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
|
---|
| 90 | I SSFIND D FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,TGLIST)
|
---|
| 91 | I 'SSFIND D FPLIST(FILENUM,SNODE,ITEM,NGET,BDT,EDT,TGLIST)
|
---|
| 92 | S DFN=""
|
---|
| 93 | F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
|
---|
| 94 | . K GPLIST
|
---|
| 95 | . M GPLIST=^TMP($J,TGLIST,DFN)
|
---|
| 96 | . S (IND,NFOUND)=0
|
---|
| 97 | . K IPLIST
|
---|
| 98 | . F S IND=$O(GPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D
|
---|
| 99 | .. S TEMP=GPLIST(IND)
|
---|
| 100 | .. S DAS=$P(TEMP,U,1)
|
---|
| 101 | ..;If this a Lab finding attach the item to the DAS.
|
---|
| 102 | .. I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS
|
---|
| 103 | ..;If this is a Mental Health finding attach the scale to DAS.
|
---|
| 104 | .. I PFINDPA(0)["YTT(601" S DAS=DAS_"S"_$P(PFINDPA(0),U,12)
|
---|
| 105 | .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
|
---|
| 106 | .. S VALUE=$G(FIEVD("VALUE"))
|
---|
| 107 | .. I INVFD D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
|
---|
| 108 | ..;If there is a status list make sure the finding has a status on
|
---|
| 109 | ..;the list.
|
---|
| 110 | .. S STATOK=$S($D(STATUSA):$$STATUSOK^PXRMINDX(.STATUSA,.FIEVD),1:1)
|
---|
| 111 | .. I 'STATOK Q
|
---|
| 112 | .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
|
---|
| 113 | .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
|
---|
| 114 | .. I SAVE D
|
---|
| 115 | ... S NFOUND=NFOUND+1
|
---|
| 116 | ... S IPLIST(CONVAL,DFN,ITEM,NFOUND,FILENUM)=TEMP_U_VALUE
|
---|
| 117 | . M ^TMP($J,PLIST)=IPLIST
|
---|
| 118 | K ^TMP($J,TGLIST)
|
---|
| 119 | Q
|
---|
| 120 | ;
|
---|