source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDL.m@ 1352

Last change on this file since 1352 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PXRMINDL ; SLC/PKR - List building routines. ;07/26/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;================================================
4EVALPL(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 ;================================================
23FPLIST(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.84 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 ;================================================
40FPLISTSS(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 ;================================================
71GPLIST(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 D GETSTATI^PXRMSTAT(FILENUM,.PFINDPA,.STATUSA)
87 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
88 ;Ignore any negative occurrence counts, date reversal not allowed
89 ;in patient lists.
90 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
91 S NGET=$S(UCIFS:50,$D(STATUSA):50,1:NOCC)
92 I SSFIND D FPLISTSS(FILENUM,SNODE,ITEM,NGET,BDT,EDT,USESTRT,TGLIST)
93 I 'SSFIND D FPLIST(FILENUM,SNODE,ITEM,NGET,BDT,EDT,TGLIST)
94 S DFN=""
95 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
96 . K GPLIST
97 . M GPLIST=^TMP($J,TGLIST,DFN)
98 . S (IND,NFOUND)=0
99 . K IPLIST
100 . F S IND=$O(GPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D
101 .. S TEMP=GPLIST(IND)
102 .. S DAS=$P(TEMP,U,1)
103 ..;If this a Lab finding attach the item to the DAS.
104 .. I PFINDPA(0)["LAB(60" S DAS=ITEM_"~"_DAS
105 ..;If this is a Mental Health finding attach the scale to DAS.
106 .. I PFINDPA(0)["YTT(601.71" S DAS=DAS_"S"_$P(PFINDPA(0),U,12)
107 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
108 .. S VALUE=$G(FIEVD("VALUE"))
109 .. I INVFD D GETDATA^PXRMVSIT(FIEVD("VISIT"),.FIEVD,0)
110 ..;If there is a status list make sure the finding has a status on
111 ..;the list.
112 .. S STATOK=$S($D(STATUSA):$$STATUSOK^PXRMINDX(.STATUSA,.FIEVD),1:1)
113 .. I 'STATOK Q
114 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
115 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
116 .. I SAVE D
117 ... S NFOUND=NFOUND+1
118 ... S IPLIST(CONVAL,DFN,ITEM,NFOUND,FILENUM)=TEMP_U_VALUE
119 . M ^TMP($J,PLIST)=IPLIST
120 K ^TMP($J,TGLIST)
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.