source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEPM.m@ 1800

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

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