source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFNFT.m@ 1777

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1PXRMFNFT ; SLC/PKR - Process found/not found text. ;10/05/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;===================================================
5AGE(DFN,DEFARR,FIEVAL,NTXT) ;Output the age match/no match
6 ;text.
7 N CTIUO,FI,IC,LC,NIN,NLINES,TEXT,TEXTIN
8 I '$D(FIEVAL("AGE")) Q
9 S NLINES=0
10 S IC=""
11 F S IC=$O(FIEVAL("AGE",IC)) Q:IC="" D
12 . S FI=$S(FIEVAL("AGE",IC):1,1:2)
13 . S NIN=$P(DEFARR(7,IC,3),U,FI)
14 . I +NIN=0 Q
15 . K TEXTIN
16 .;If CTIUO is true the text contains a TIU object.
17 . S CTIUO=$S(NIN["T":1,1:0)
18 . I CTIUO D
19 .. N VSTR S VSTR=""
20 ..;TIU expansion expects the trailing 0, i.e. TEXTIN(N,0).
21 .. F LC=1:1:+NIN S TEXTIN(LC,0)=^PXD(811.9,PXRMITEM,7,IC,FI,LC,0)
22 .. S NIN=NIN+1,TEXTIN(NIN,0)="\\"
23 .. D FNFTXTO(1,DFN,"TEXTIN",VSTR,.NLINES,.TEXT)
24 . I 'CTIUO D
25 .. F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,7,IC,FI,LC,0)
26 .. S NIN=NIN+1,TEXTIN(NIN)="\\"
27 .. D FNFTXTR(1,NIN,.TEXTIN,.NLINES,.TEXT)
28 D COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
29 Q
30 ;
31 ;===================================================
32FINDING(INDENT,DFN,FINDING,IFIEVAL,NLINES,TEXT) ;Output the finding found/not
33 ;found text.
34 N CTIUO,FI,LC,NIN,NODE,TEMP,TEXTIN
35 S FI=$S(IFIEVAL:1,1:2)
36 S NODE=$S(FINDING["FF":25,1:20)
37 S TEMP=$G(DEFARR(NODE,FINDING,6))
38 S NIN=$P(TEMP,U,FI)
39 I +NIN=0 Q
40 I FINDING["FF" S FINDING=$P(FINDING,"FF",2)
41 S CTIUO=$S(NIN["T":1,1:0)
42 I CTIUO D
43 . S NIN=+NIN
44 . N VSTR
45 .;TIU expansion expects the trailing 0, i.e. TEXTIN(N,0).
46 . F LC=1:1:+NIN S TEXTIN(LC,0)=^PXD(811.9,PXRMITEM,NODE,FINDING,FI,LC,0)
47 . I $D(IFIEVAL("VISIT")) D
48 .. N TEMP,VDATE,VLOC,VSC
49 .. S TEMP=^AUPNVSIT(IFIEVAL("VISIT"),0)
50 .. S VDATE=$P(TEMP,U,1)
51 .. S VLOC=$P(TEMP,U,22)
52 .. S VSC=$P(TEMP,U,7)
53 .. S VSTR=VLOC_";"_VDATE_";"_VSC
54 . E S VSTR=""
55 . S NIN=NIN+1,TEXTIN(NIN,0)="\\"
56 . D FNFTXTO(INDENT,DFN,"TEXTIN",VSTR,.NLINES,.TEXT)
57 I 'CTIUO D
58 . F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,NODE,FINDING,FI,LC,0)
59 . S NIN=NIN+1,TEXTIN(NIN)="\\"
60 . D FNFTXTR(INDENT,NIN,.TEXTIN,.NLINES,.TEXT)
61 Q
62 ;
63 ;===================================================
64FNFTXTO(INDENT,DFN,FNFGBL,VSTR,NLINES,TEXT) ;Load found/not found text
65 ;that contains TIU objects.
66 N OBJECT,LC,NUML,TA
67 ;Make sure this works if it is being called a part of an object.
68 I $D(^TMP("TIUBOIL",$J)) D
69 . K ^TMP("PXRMTIUBOIL",$J)
70 . M ^TMP("PXRMTIUBOIL",$J)=^TMP("TIUBOIL",$J)
71 . S OBJECT=1
72 E S OBJECT=0
73 K ^TMP("TIUBOIL",$J)
74 D BLRPLT^TIUSRVD(.TA,"",DFN,VSTR,FNFGBL)
75 S NUML=$P(^TMP("TIUBOIL",$J,0),U,3)
76 I NUML=0 D Q
77 . K ^TMP("TIUBOIL",$J)
78 . I OBJECT M ^TMP("TIUBOIL",$J)=^TMP("PXRMTIUBOIL",$J)
79 . K ^TMP("PXRMTIUBOIL",$J)
80 N NOUT,TEXTIN,TEXTOUT
81 F LC=1:1:NUML S TEXTIN(LC)=^TMP("TIUBOIL",$J,LC,0)
82 D FORMAT^PXRMTEXT(INDENT,PXRMRM,NUML,.TEXTIN,.NOUT,.TEXTOUT)
83 F LC=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(LC)
84 K ^TMP("TIUBOIL",$J)
85 I OBJECT M ^TMP("TIUBOIL",$J)=^TMP("PXRMTIUBOIL",$J) K ^TMP("PXRMTIUBOIL",$J)
86 Q
87 ;
88 ;===================================================
89FNFTXTR(INDENT,NIN,TEXTIN,NLINES,TEXT) ;Load regular found/not found text
90 ;that does not contain TIU objects.
91 N JND,NOUT,TEXTOUT
92 D FORMAT^PXRMTEXT(INDENT,PXRMRM,NIN,.TEXTIN,.NOUT,.TEXTOUT)
93 F JND=1:1:NOUT S NLINES=NLINES+1,TEXT(NLINES)=TEXTOUT(JND)
94 Q
95 ;
96 ;===================================================
97LOGIC(DFN,LOGSTR,LOGTYPE,TTYPE,DEFARR,NTXT) ;Output the detailed
98 ;logic found/not found text.
99 I LOGSTR="" Q
100 N CTIUO,FI,LC,NIN,NLINES,SUB,TEXT,TEXTIN
101 I TTYPE="S" S NIN=$S(LOGTYPE="PCL":DEFARR(72),LOGTYPE="RES":DEFARR(77),1:0)
102 E S NIN=$S(LOGTYPE="PCL":DEFARR(62),LOGTYPE="RES":DEFARR(67),1:0)
103 I NIN="" Q
104 S FI=$P(LOGSTR,U,1)
105 S NIN=$S(FI=1:$P(NIN,U,1),FI=0:$P(NIN,U,2),1:0)
106 I +NIN=0 Q
107 I TTYPE="S" D
108 . I LOGTYPE="PCL",FI=1 S SUB=70
109 . I LOGTYPE="PCL",FI=0 S SUB=71
110 . I LOGTYPE="RES",FI=1 S SUB=75
111 . I LOGTYPE="RES",FI=0 S SUB=76
112 E D
113 . I LOGTYPE="PCL",FI=1 S SUB=60
114 . I LOGTYPE="PCL",FI=0 S SUB=61
115 . I LOGTYPE="RES",FI=1 S SUB=65
116 . I LOGTYPE="RES",FI=0 S SUB=66
117 S NLINES=0
118 S CTIUO=$S(NIN["T":1,1:0)
119 I CTIUO D
120 . N VSTR S VSTR=""
121 .;TIU expansion expects the trailing 0, i.e. TEXTIN(N,0).
122 . F LC=1:1:+NIN S TEXTIN(LC,0)=^PXD(811.9,PXRMITEM,SUB,LC,0)
123 . S NIN=NIN+1,TEXTIN(NIN,0)="\\"
124 . D FNFTXTO(1,DFN,"TEXTIN",VSTR,.NLINES,.TEXT)
125 I 'CTIUO D
126 . F LC=1:1:NIN S TEXTIN(LC)=^PXD(811.9,PXRMITEM,SUB,LC,0)
127 . S NIN=NIN+1,TEXTIN(NIN)="\\"
128 . D FNFTXTR(1,NIN,.TEXTIN,.NLINES,.TEXT)
129 D COPYTXT^PXRMOUTU(.NTXT,NLINES,.TEXT)
130 Q
131 ;
132 ;===================================================
133SNMLA(RIEN) ;Set the number of match lines for the age match text.
134 N IND,JND,LC,MATCHLC,NBAR,RES
135 S IND=0
136 F S IND=+$O(^PXD(811.9,RIEN,7,IND)) Q:IND=0 D
137 .;Age match text
138 . S (JND,LC,NBAR)=0
139 . F S JND=$O(^PXD(811.9,RIEN,7,IND,1,JND)) Q:JND="" D
140 .. S NBAR=NBAR+$L(^PXD(811.9,RIEN,7,IND,1,JND,0),"|")-1
141 .. S LC=LC+1
142 .. I NBAR>1 S LC=LC_"T"
143 . S MATCHLC=LC
144 .;Age no match text
145 . S (JND,LC,NBAR)=0
146 . F S JND=$O(^PXD(811.9,RIEN,7,IND,2,JND)) Q:JND="" D
147 .. S NBAR=NBAR+$L(^PXD(811.9,RIEN,7,IND,2,JND,0),"|")-1
148 .. S LC=LC+1
149 .. I NBAR>1 S LC=LC_"T"
150 . S ^PXD(811.9,RIEN,7,IND,3)=MATCHLC_U_LC
151 Q
152 ;
153 ;===================================================
154SNMLF(RIEN,NODE) ;Set the number of found lines for the found text.
155 ;For regular and functional findings.
156 N FI,IND,JND,LC,NBAR,RES
157 S IND=0
158 F S IND=+$O(^PXD(811.9,RIEN,NODE,IND)) Q:IND=0 D
159 .;Found text
160 . S (JND,LC,NBAR)=0
161 . F S JND=$O(^PXD(811.9,RIEN,NODE,IND,1,JND)) Q:JND="" D
162 .. S NBAR=NBAR+$L(^PXD(811.9,RIEN,NODE,IND,1,JND,0),"|")-1
163 .. S LC=LC+1
164 .. I NBAR>1 S LC=LC_"T"
165 . S FI=LC
166 .;Not found text
167 . S (JND,LC,NBAR)=0
168 . F S JND=$O(^PXD(811.9,RIEN,NODE,IND,2,JND)) Q:JND="" D
169 .. S NBAR=NBAR+$L(^PXD(811.9,RIEN,NODE,IND,2,JND,0),"|")-1
170 .. S LC=LC+1
171 .. I NBAR>1 S LC=LC_"T"
172 . S ^PXD(811.9,RIEN,NODE,IND,6)=FI_U_LC
173 Q
174 ;
175 ;===================================================
176SNMLL(RIEN) ;Set the number of lines for the logic found/not found
177 ;text. Append a "T" to the number of lines if the text contains
178 ;a TIU object.
179 N CSTR,IND,LC,NBAR,RES,SUB
180 ;SUB=60 General cohort found text
181 ;SUB=61 General cohort not found text
182 ;SUB=65 General resolution found text
183 ;SUB=66 General resolution not found text
184 ;SUB=70 Summary cohort found text
185 ;SUB=71 Summary cohort not found text
186 ;SUB=75 Summary resolution found text
187 ;SUB=76 Summary resolution not found text
188 F SUB=60,61,65,66,70,71,75,76 D
189 . S (IND,LC,NBAR)=0
190 . F S IND=$O(^PXD(811.9,RIEN,SUB,IND)) Q:IND="" D
191 .. S NBAR=NBAR+$L(^PXD(811.9,RIEN,SUB,IND,0),"|")-1
192 .. S LC=LC+1
193 . I NBAR>1 S LC=LC_"T"
194 . I SUB=60 S CSTR=LC
195 . I SUB=61 S ^PXD(811.9,RIEN,62)=CSTR_U_LC
196 . I SUB=65 S CSTR=LC
197 . I SUB=66 S ^PXD(811.9,RIEN,67)=CSTR_U_LC
198 . I SUB=70 S CSTR=LC
199 . I SUB=71 S ^PXD(811.9,RIEN,72)=CSTR_U_LC
200 . I SUB=75 S CSTR=LC
201 . I SUB=76 S ^PXD(811.9,RIEN,77)=CSTR_U_LC
202 Q
203 ;
Note: See TracBrowser for help on using the repository browser.