source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1PXRMETT ; SLC/PJH - Extract Summary Display ;04/09/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;Main entry point for PXRM EXTRACT SUMMARY
5START(IEN) N TOGGLE,TOGGLE1,VALMBCK,VALMBG,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
6 S X="IORESET"
7 D ENDR^%ZISS
8 S VALMCNT=0,TOGGLE=0,TOGGLE1=0
9 D EN^VALM("PXRM EXTRACT SUMMARY")
10 Q
11 ;
12BLDLIST(IEN,FINDINGS,PATIENT) ;Build workfile.
13 ;FINDINGS=1 means display finding totals
14 K ^TMP("PXRMETT",$J)
15 ;Build a list of extract summary totals.
16 N APPL,DATA,DUE,IND,LIST,NDUE,NAPPL,OLIST
17 N PLCNT,PLIST,RIEN,RNAME,SARRAY,SEQ,SNAME,STATION,TOT
18 ;Build the list in alphabetical order.
19 S VALMCNT=0,OLIST="",PLCNT=0
20 S IND=0 F S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:IND'>0 D
21 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA=""
22 .S RIEN=$P(DATA,U,2) Q:'RIEN
23 .S RNAME=$P(^PXD(811.9,RIEN,0),U,3)
24 .I RNAME="" S RNAME=$P(^PXD(811.9,RIEN,0),U,1)
25 .S STATION=$P(DATA,U,3),SARRAY=""
26 .D GETS^DIQ(4,STATION,99,"E","SARRAY")
27 .S SNAME=$G(SARRAY(4,STATION_",",99,"E"))
28 .I SNAME="" S SNAME=STATION
29 .S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),NAPPL=+$P(DATA,U,7)
30 .S DUE=+$P(DATA,U,8),NDUE=+$P(DATA,U,9)
31 .S PLIST=$P(DATA,U,4)
32 .I PLIST,PLIST'=OLIST D
33 ..I PLCNT>0 D
34 ...S VALMCNT=VALMCNT+1
35 ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
36 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
37 ..S PLNAME=$P($G(^PXRMXP(810.5,PLIST,0)),U),OLIST=PLIST Q:PLNAME=""
38 ..S VALMCNT=VALMCNT+1,PLCNT=PLCNT+1
39 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
40 ..S ^TMP("PXRMETT",$J,"SEL",PLCNT)=PLIST
41 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR(PLCNT,4," ")_" "_PLNAME
42 .S VALMCNT=VALMCNT+1
43 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FRE(VALMCNT,RNAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE)
44 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
45 .;Finding totals
46 .I +FINDINGS>0 D FBLD(PATIENT)
47 ;
48 S ^TMP("PXRMETT",$J,"VALMCNT")=VALMCNT
49 Q
50 ;
51ENTRY ;Entry code
52 D BLDLIST(IEN,TOGGLE,TOGGLE1),XQORM
53 Q
54 ;
55EXIT ;Exit code
56 K ^TMP("PXRMETT",$J)
57 K ^TMP("PXRMETTH",$J)
58 D CLEAN^VALM10
59 D FULL^VALM1
60 S VALMBCK="Q"
61 Q
62 ;
63FBLD(PATIENT) ;Build finding list
64 N APPL,DATA,DUE,ETYP,EVAL,GNAM,GTYP
65 N NAPPL,NDUE,OGNAM,SEQ,SUB,TIEN,TNAME,TOTAL
66 S SUB=0,OGNAM=""
67 F S SUB=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB)) Q:'SUB D
68 .S DATA=$G(^PXRMXT(810.3,IEN,3,IND,1,SUB,0)) Q:DATA=""
69 .S TIEN=$P(DATA,U,2) Q:'TIEN
70 .S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
71 .S SEQ=$P(DATA,U),ETYP=$P(DATA,U,3),GNAM=$P(DATA,U,9),GTYP=$P(DATA,U,10)
72 .S TOT=+$P(DATA,U,4),APPL=+$P(DATA,U,5),NAPPL=+$P(DATA,U,6)
73 .S DUE=+$P(DATA,U,7),NDUE=+$P(DATA,U,8)
74 .I OGNAM'=GNAM D
75 ..I OGNAM'="" D
76 ...S VALMCNT=VALMCNT+1
77 ...S ^TMP("PXRMETT",$J,VALMCNT,0)=""
78 ...S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
79 ..S OGNAM=GNAM,VALMCNT=VALMCNT+1
80 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$$RJ^XLFSTR("Counting Group: ",21)_GNAM
81 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)="",VALMCNT=VALMCNT+1
82 ..S ^TMP("PXRMETT",$J,VALMCNT,0)=$J("",6)_$$LJ^XLFSTR($$TXT^PXRMEPM(ETYP,GTYP),49)
83 ..S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
84 .S VALMCNT=VALMCNT+1
85 .S ^TMP("PXRMETT",$J,VALMCNT,0)=$$FREF(VALMCNT,TNAME,SEQ,TOT,APPL,NAPPL,DUE,NDUE,ETYP)
86 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
87 .I +PATIENT>0 D PBLD(IEN,IND,SUB)
88 S VALMCNT=VALMCNT+1
89 S ^TMP("PXRMETT",$J,VALMCNT,0)=""
90 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
91 Q
92 ;
93FLIST ;Toggle list with/without finding totals
94 S TOGGLE=(TOGGLE+1)#2
95 I TOGGLE=0 S TOGGLE1=0
96 ;Rebuild Workfile
97 D BLDLIST(IEN,TOGGLE,TOGGLE1)
98 ;Refresh
99 S VALMBCK="R",VALMBG=1
100 Q
101 ;
102FRE(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE) ;Format reminder entry
103 N TEMP,TNAME,TSOURCE
104 S TEMP=" "
105 S TNAME=SNAME_"/"_$E(NAME,1,35-$L(SNAME))
106 S TEMP=TEMP_$$LJ^XLFSTR(TNAME,36," ")
107 S TEMP=TEMP_$$RJ^XLFSTR(TOT,8," ")
108 S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
109 S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
110 S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
111 S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
112 Q TEMP
113 ;
114FREF(NUMBER,NAME,SNAME,TOT,APPL,NAPPL,DUE,NDUE,ETYP) ;Format finding entry
115 N TEMP,TNAME,TSOURCE
116 S TEMP=" "
117 S TNAME=$E(NAME,1,31)
118 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,31," ")
119 S TEMP=TEMP_" "_$$RJ^XLFSTR(TOT,8," ")
120 I ETYP'="FC" D
121 .S TEMP=TEMP_$$RJ^XLFSTR(APPL,8," ")
122 .S TEMP=TEMP_$$RJ^XLFSTR(NAPPL,7," ")
123 .S TEMP=TEMP_$$RJ^XLFSTR(DUE,7," ")
124 .S TEMP=TEMP_$$RJ^XLFSTR(NDUE,7," ")
125 Q TEMP
126 ;
127HDR ; Header code
128 S VALMHDR(1)="Extract Summary Name: "_$P($G(^PXRMXT(810.3,IEN,0)),U)
129 S VALMHDR(2)=" Extract Period: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,2),"5Z")_" - "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,3),"5Z")
130 S VALMHDR(2)=VALMHDR(2)_" Created: "_$$FMTE^XLFDT($P($G(^PXRMXT(810.3,IEN,0)),U,6),"5Z")
131 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
132 Q
133 ;
134HLP ;Help code
135 N ORU,ORUPRMT,XQORM
136 S SUB="PXRMETTH"
137 D EN^VALM("PXRM EXTRACT HELP")
138 Q
139 ;
140INIT ;Init
141 S VALMCNT=0
142 Q
143 ;
144PBLD(IEN,IND,SUB) ;
145 N ARRAY,NAME,LEN,PCNT,DFN,CNT,USTR
146 S VALMCNT=VALMCNT+1,CNT=0
147 S PCNT=0 F S PCNT=$O(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT)) Q:PCNT'>0 D
148 .S DFN=$P($G(^PXRMXT(810.3,IEN,3,IND,1,SUB,1,PCNT,0)),U) Q:DFN'>0
149 .S NAME=$P($G(^DPT(DFN,0)),U)
150 .S CNT=CNT+1,ARRAY(NAME)=""
151 S ^TMP("PXRMETT",$J,VALMCNT,0)=" "_$$RJ^XLFSTR("Unique Applicable Patients ("_CNT_")",36," ")
152 S USTR=$P($G(^TMP("PXRMETT",$J,VALMCNT,0)),"U"),LEN=$L(USTR)
153 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
154 S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
155 .S VALMCNT=VALMCNT+1
156 .S ^TMP("PXRMETT",$J,VALMCNT,0)=USTR_$$LJ^XLFSTR(NAME,36," ")
157 .S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
158 S VALMCNT=VALMCNT+1
159 S ^TMP("PXRMETT",$J,VALMCNT,0)=" "
160 S ^TMP("PXRMETT",$J,"IDX",VALMCNT,PLCNT)=""
161 Q
162 ;
163PEXIT ;Protocol exit code
164 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
165 D XQORM
166 Q
167 ;
168PLIST(IEN) ;Patient list display
169 N IND,PLIEN,VALMY
170 D EN^VALM2(XQORNOD(0))
171 ;If there is no list quit.
172 I '$D(VALMY) Q
173 ;PXRMDONE is newed in PXRMLPM
174 S PXRMDONE=0
175 S IND=""
176 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
177 .;Get the ien.
178 .S PLIEN=^TMP("PXRMETT",$J,"SEL",IND)
179 .D START^PXRMLPP(PLIEN)
180 S VALMBCK="R"
181 Q
182 ;
183PLIST1 ;Toggle list with/without finding totals
184 S TOGGLE1=(TOGGLE1+1)#2
185 ;Rebuild Workfile
186 D BLDLIST(IEN,TOGGLE,TOGGLE1)
187 ;Refresh
188 S VALMBCK="R",VALMBG=1
189 Q
190 ;
191XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT SUMMARY SELECT ENTRY",0))_U_"1:"_VALMCNT
192 S XQORM("A")="Select Item: "
193 Q
194 ;
195XSEL ;PXRM EXTRACT TOTALS SELECT ENTRY validation
196 N SEL,PLIEN
197 S SEL=$P(XQORNOD(0),"=",2)
198 ;Remove trailing ,
199 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
200 ;Invalid selection
201 I SEL["," D Q
202 .W $C(7),!,"Only one item number allowed." H 2
203 .S VALMBCK="R"
204 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("SEL",SEL))) D Q
205 .W $C(7),!,SEL_" is not a valid item number." H 2
206 .S VALMBCK="R"
207 ;Get the list ien.
208 S PLIEN=^TMP("PXRMETT",$J,"SEL",SEL)
209 D START^PXRMLPP(PLIEN)
210 S VALMBCK="R"
211 Q
212 ;
Note: See TracBrowser for help on using the repository browser.