source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFF.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PXRMFF ;SLC/PKR - Clinical Reminders function finding evaluation. ;3/29/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;===========================================
4EVAL(DFN,DEFARR,FIEVAL) ;Evaluate function findings.
5 N FFIND,FFN,FILIST,FN,FUN,FUNIND,FUNN,FVALUE,JND
6 N LOGIC,NL,ROUTINE,TEMP
7 I '$D(DEFARR(25)) Q
8 S FFN="FF"
9 F S FFN=$O(DEFARR(25,FFN)) Q:FFN'["FF" D
10 . K FN
11 . S FUNIND=0
12 . F S FUNIND=+$O(DEFARR(25,FFN,5,FUNIND)) Q:FUNIND=0 D
13 .. S FUNN=$P(DEFARR(25,FFN,5,FUNIND,0),U,1)
14 .. S FUN=$P(DEFARR(25,FFN,5,FUNIND,0),U,2)
15 .. S TEMP=^PXRMD(802.4,FUN,0)
16 .. S ROUTINE=$P(TEMP,U,2,3)_"(.FILIST,.FIEVAL,.FVALUE)"
17 .. K FILIST
18 .. S (JND,NL)=0
19 .. F S JND=+$O(DEFARR(25,FFN,5,FUNIND,20,JND)) Q:JND=0 D
20 ... S NL=NL+1
21 ... S FILIST(NL)=DEFARR(25,FFN,5,FUNIND,20,JND,0)
22 .. S FILIST(0)=NL
23 .. D @ROUTINE
24 .. S FN(FUNIND)=FVALUE
25 . S LOGIC=$G(DEFARR(25,FFN,10))
26 . S LOGIC=$S(LOGIC'="":LOGIC,1:0)
27 . I @LOGIC
28 . S FIEVAL(FFN)=$T
29 . S FIEVAL(FFN,"NUMBER")=$P(FFN,"FF",2)
30 . S FIEVAL(FFN,"FINDING")=$G(FUN)_";PXRMD(802.4,"
31 Q
32 ;
33 ;===========================================
34EVALPL(DEFARR,FFIND,PLIST) ;Build a list of patients based on a function
35 ;finding.
36 N COUNT,DAS,DATE,DFN
37 N FI,FIEVAL,FIEVT,FIL,FILIST,FILENUM,FINDPA,FN
38 N FUN,FUNNM,FUNN,FUNNUM,FVALUE
39 N IND,ITEM,JND,LOGIC,LNAME,NFI,NFUN,ROUTINE,TEMP,TERMARR,UNIQFIL
40 S LOGIC=DEFARR(25,FFIND,10)
41 I LOGIC="" Q
42 ;Build the list of functions and findings used by the function finding.
43 S (FUNNUM,NFUN)=0
44 F S FUNNUM=+$O(DEFARR(25,FFIND,5,FUNNUM)) Q:FUNNUM=0 D
45 . S NFUN=NFUN+1
46 . S FUNN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,1)
47 . S FUN=$P(DEFARR(25,FFIND,5,FUNNUM,0),U,2)
48 . S TEMP=^PXRMD(802.4,FUN,0)
49 . S ROUTINE(NFUN)=$P(TEMP,U,2,3)_"(.FIL,.FIEVAL,.FVALUE)"
50 . S (FI,NFI)=0
51 . F S FI=+$O(DEFARR(25,FFIND,5,FUNNUM,20,FI)) Q:FI=0 D
52 .. S NFI=NFI+1,FILIST(NFUN,NFI)=DEFARR(25,FFIND,5,FUNNUM,20,FI,0)
53 . S FILIST(NFUN,0)=NFI
54 ;A finding may be used in more than one function in the function
55 ;finding so build a list of the unique findings.
56 F IND=1:1:NFUN D
57 . F JND=1:1:FILIST(IND,0) D
58 .. S TEMP=$P(DEFARR(20,FILIST(IND,JND),0),U,1)
59 .. S ITEM=$P(TEMP,";",1)
60 .. S FILENUM=$$GETFNUM^PXRMDATA($P(TEMP,";",2))
61 .. S UNIQFIL(FILIST(IND,JND))=""
62 K ^TMP($J,"PXRMFFDFN")
63 S IND=0
64 F S IND=$O(UNIQFIL(IND)) Q:IND="" D
65 . S FINDPA(0)=DEFARR(20,IND,0)
66 . S FINDPA(3)=DEFARR(20,IND,3)
67 . S FINDPA(10)=DEFARR(20,IND,10)
68 . S FINDPA(11)=DEFARR(20,IND,11)
69 . D GENTERM^PXRMPLST(FINDPA(0),IND,.TERMARR)
70 . S LNAME(IND)="PXRMFF"_IND
71 . K ^TMP($J,LNAME(IND))
72 . D EVALPL^PXRMTERL(.FINDPA,.TERMARR,LNAME(IND))
73 .;Get rid of the false part of the list.
74 . K ^TMP($J,LNAME(IND),0)
75 .;Build a complete list of patients.
76 . S DFN=0
77 . F S DFN=$O(^TMP($J,LNAME(IND),1,DFN)) Q:DFN="" S ^TMP($J,"PXRMFFDFN",DFN)=""
78 ;Evaluate the function finding for each patient. If the function
79 ;finding is true then add the patient to PLIST.
80 S DFN=0
81 F S DFN=$O(^TMP($J,"PXRMFFDFN",DFN)) Q:DFN="" D
82 . K FIEVAL
83 . S IND=""
84 . F S IND=$O(UNIQFIL(IND)) Q:IND="" D
85 .. S FIEVAL(IND)=0
86 .. S ITEM=""
87 .. F S ITEM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM)) Q:ITEM="" D
88 ... S COUNT=0
89 ... F S COUNT=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT)) Q:COUNT="" D
90 .... S FILENUM=$O(^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,""))
91 .... S TEMP=^TMP($J,LNAME(IND),1,DFN,ITEM,COUNT,FILENUM)
92 .... S DAS=$P(TEMP,U,1)
93 .... S DATE=$P(TEMP,U,2)
94 .... K FIEVT
95 .... D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVT)
96 .... M FIEVAL(IND,COUNT)=FIEVT
97 .... S FIEVAL(IND,COUNT,"DATE")=DATE,FIEVAL(IND,COUNT)=1
98 .;Save the top level results for each finding.
99 . S IND=0
100 . F S IND=$O(FIEVAL(IND)) Q:IND="" D
101 .. K FIEVT M FIEVT=FIEVAL(IND)
102 .. S NFI=+$O(FIEVT(""),-1)
103 .. D SFRES^PXRMUTIL(-1,NFI,.FIEVT)
104 .. K FIEVAL(IND) M FIEVAL(IND)=FIEVT
105 .;Evaluate the function finding for this patient.
106 . K FN
107 . F IND=1:1:NFUN D
108 .. K FIL M FIL=FILIST(IND)
109 .. D @ROUTINE(IND)
110 .. S FN(IND)=FVALUE
111 . I @LOGIC S ^TMP($J,PLIST,1,DFN,1,FFIND)=""
112 ;Clean up.
113 K ^TMP($J,"PXRMFFDFN")
114 S IND=""
115 F S IND=$O(UNIQFIL(IND)) Q:IND="" K ^TMP($J,LNAME(IND))
116 Q
117 ;
118 ;===========================================
119MHVOUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the MHV output.
120 ;None currently defined.
121 Q
122 ;
123 ;===========================================
124OUTPUT(INDENT,IFIEVAL,NLINES,TEXT) ;Produce the clinical
125 ;maintenance output. None currently defined.
126 Q
127 ;
Note: See TracBrowser for help on using the repository browser.