source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEPM.m@ 1259

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

revised back to 6/30/08 version

File size: 4.5 KB
Line 
1PXRMEPM ; SLC/PKR/PJH - Extract Definition Management ;06/21/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Main entry point for PXRM EXTRACT DEFINITIONS
5START N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
6 S X="IORESET"
7 D ENDR^%ZISS
8 S VALMCNT=0
9 D EN^VALM("PXRM EXTRACT DEFINITIONS")
10 Q
11 ;
12BLDLIST ;Build workfile
13 K ^TMP("PXRMEPM",$J)
14 N IEN,IND,PLIST
15 D LIST^PXRMETM(.PLIST,.IEN)
16 M ^TMP("PXRMEPM",$J)=PLIST
17 S VALMCNT=PLIST("VALMCNT")
18 F IND=1:1:VALMCNT D
19 .S ^TMP("PXRMEPM",$J,"IDX",IND,IND)=IEN(IND)
20 Q
21 ;
22ENTRY ;Entry code
23 D BLDLIST,XQORM
24 Q
25 ;
26EXIT ;Exit code
27 K ^TMP("PXRMEPM",$J)
28 K ^TMP("PXRMEPMH",$J)
29 D CLEAN^VALM10
30 D FULL^VALM1
31 S VALMBCK="Q"
32 Q
33 ;
34HDR ; Header code
35 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
36 Q
37 ;
38HLP ;Help code
39 N ORU,ORUPRMT,SUB,XQORM
40 S SUB="PXRMEPMH"
41 D EN^VALM("PXRM EXTRACT HELP")
42 Q
43 ;
44INIT ;Init
45 S VALMCNT=0
46 Q
47 ;
48PEXIT ;PXRM EXCH MENU protocol exit code
49 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
50 ;Reset after page up/down etc
51 D XQORM
52 Q
53 ;
54XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT DEFINITION SELECT ENTRY",0))_U_"1:"_VALMCNT
55 S XQORM("A")="Select Item: "
56 Q
57 ;
58XSEL ;PXRM EXTRACT DEFINITION SELECT ENTRY validation
59 N SEL,IEN
60 S SEL=$P(XQORNOD(0),"=",2)
61 ;Remove trailing ,
62 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
63 ;Invalid selection
64 I SEL["," D Q
65 .W $C(7),!,"Only one item number allowed." H 2
66 .S VALMBCK="R"
67 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
68 .W $C(7),!,SEL_" is not a valid item number." H 2
69 .S VALMBCK="R"
70 ;
71 ;Get the list ien.
72 S IEN=^TMP("PXRMEPM",$J,"IDX",SEL,SEL)
73 ;Display/Edit Extract Definition
74 D START^PXRMEPED(IEN)
75 D BLDLIST
76 S VALMBCK="R"
77 Q
78 ;
79HELP(CALL) ;General help text routine
80 N HTEXT
81 I CALL=1 D
82 .S HTEXT(1)="Select DE to display or edit a definition."
83 .S HTEXT(2)="Select ED to edit a definition"
84 D HELP^PXRMEUT(.HTEXT)
85 Q
86 ;
87EPADD ;Add Rule Option
88 ;
89 ;Reset Screen Mode
90 W IORESET
91 ;
92 ;Add Rule
93 D ADD^PXRMEPED
94 ;
95 ;Rebuild Workfile
96 D BLDLIST
97 ;
98 S VALMBCK="R"
99 Q
100 ;
101EPINQ ;Definition Inquiry - PXRM EXTRACT DEFINITION DISPLAY/EDIT entry
102 N IND,LRIEN,VALMY
103 D EN^VALM2(XQORNOD(0))
104 ;
105 ;If there is no list quit.
106 I '$D(VALMY) Q
107 S PXRMDONE=0
108 S IND=""
109 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
110 .;Get the ien.
111 .S LRIEN=^TMP("PXRMEPM",$J,"IDX",IND,IND)
112 .D START^PXRMEPED(LRIEN)
113 D BLDLIST
114 S VALMBCK="R"
115 Q
116 ;
117PPLR ;Display rule set components
118 ;used by [PXRM EXTRACT DEFINITION] template)
119 N ACT,DATA,FIRST,IEN,LRDATA,LRIEN,SEQ,SUB
120 S IEN=$P(X,U,2) Q:'IEN
121 W !," Description: ",$P($G(^PXRM(810.4,IEN,0)),U,2)
122 S SEQ="",FIRST=1
123 F S SEQ=$O(^PXRM(810.4,IEN,30,"B",SEQ)) Q:'SEQ D
124 .S SUB=$O(^PXRM(810.4,IEN,30,"B",SEQ,"")) Q:'SUB
125 .S DATA=$G(^PXRM(810.4,IEN,30,SUB,0)) Q:DATA=""
126 .S LRIEN=$P(DATA,U,2) Q:LRIEN=""
127 .S ACT=$P(DATA,U,3),LRDATA=$G(^PXRM(810.4,LRIEN,0))
128 .I FIRST W !!,?2,"List Rules:" S FIRST=0
129 .W !,?2,SEQ,?7,$P(LRDATA,U),?66
130 .W $S(ACT="A":"ADD PATIENT",ACT="R":"REMOVE PATIENT",ACT="F":"INSERT FINDING",1:"SELECT PATIENT")
131 .;Display List Rule fields
132 .D LROUT^PXRMLRED(LRIEN,23)
133 .W !
134 Q
135 ;
136PPFR ;Display counting rules and count type
137 ;used by [PXRM EXTRACT DEFINITION] template)
138 W !
139 N DATA,GIEN,GSTATUS,IEN,SEQ,SUB
140 S IEN=$P(X,U,3) Q:'IEN
141 S SEQ=""
142 F S SEQ=$O(^PXRM(810.7,IEN,10,"B",SEQ)) Q:SEQ="" D
143 .S SUB=$O(^PXRM(810.7,IEN,10,"B",SEQ,"")) Q:'SUB
144 .S DATA=$G(^PXRM(810.7,IEN,10,SUB,0)) Q:DATA=""
145 .S GIEN=$P(DATA,U,2) Q:GIEN=""
146 .S GSTATUS=$P(DATA,U,3)
147 .;Get counting groups
148 .N CTYP,CTXT,DATA,EXCL,FIRST,GNAME,PNAME,TIEN,TNAME,GSEQ,GSUB
149 .S DATA=$G(^PXRM(810.8,GIEN,0)),GNAME=$P(DATA,U)
150 .S CTYP=$P(DATA,U,3),PNAME=$P(DATA,U,2),GSEQ="",FIRST=1
151 .S CTXT=$$TXT(CTYP,GSTATUS)
152 .F S GSEQ=$O(^PXRM(810.8,GIEN,10,"B",GSEQ)) Q:GSEQ="" D
153 ..S GSUB=$O(^PXRM(810.8,GIEN,10,"B",GSEQ,"")) Q:'GSUB
154 ..S DATA=$G(^PXRM(810.8,GIEN,10,GSUB,0)) Q:DATA=""
155 ..S TIEN=$P(DATA,U,2) Q:TIEN=""
156 ..S EXCL=$P(DATA,U,3) Q:EXCL="E"
157 ..S TNAME=$P($G(^PXRMD(811.5,TIEN,0)),U)
158 ..I FIRST D
159 ...W !,?14,SEQ
160 ...W ?18,"Counting Group: ",GNAME
161 ...W !,?18,$$TXT(CTYP,GSTATUS)
162 ...W !,?23,"Terms:" S FIRST=0
163 ..W ?30,TNAME,!
164 Q
165 ;
166SCREEN ;Screen for 810.210 field .02
167 S DIC("S")="I $P(^(0),U,3)=3"
168 Q
169 ;
170TXT(COUNT,COHORT) ;Text to describe group
171 N TXT
172 ;Determine count type
173 I COUNT="MRFP" S TXT="Most recent finding patient counts for "
174 I COUNT="MRF" S TXT="Most recent finding counts for "
175 I COUNT="UR" S TXT="Utilization in period finding counts for "
176 ;Error
177 I $G(TXT)="" Q "Unknown count type - error"
178 ;Determine cohort
179 S TXT=TXT_$S(COHORT="A":"APPLICABLE",1:"TOTAL")_" patients"
180 Q TXT
Note: See TracBrowser for help on using the repository browser.