source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMETT.m@ 808

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

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