source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEFM.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PXRMEFM ; SLC/PKR/PJH - Extract Counting Rule Management ;08/03/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Main entry point for PXRM EXTRACT COUNTING RULES
5START(PIEN) ;
6 N PXRMDONE,VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
7 S X="IORESET"
8 D ENDR^%ZISS
9 S VALMCNT=0
10 D EN^VALM("PXRM EXTRACT COUNTING RULES")
11 Q
12 ;
13BLDLIST ;Build workfile
14 K ^TMP("PXRMEFM",$J)
15 N IEN,IND,PLIST
16 D LIST(.PLIST,.IEN,PIEN)
17 M ^TMP("PXRMEFM",$J)=PLIST
18 S VALMCNT=PLIST("VALMCNT")
19 F IND=1:1:VALMCNT S ^TMP("PXRMEFM",$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("PXRMEFM",$J)
28 K ^TMP("PXRMEFMH",$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="PXRMEFMH"
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 COUNTING RULE SELECT ENTRY",0))_U_"1:"_VALMCNT
55 S XQORM("A")="Select Item: "
56 Q
57 ;
58XSEL ;PXRM EXTRACT COUNTING RULE 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("PXRMEFM",$J,"IDX",SEL,SEL)
73 ;Display/Edit Extract Finding
74 D START^PXRMEFED(IEN)
75 ;
76 D BLDLIST
77 ;
78 S VALMBCK="R"
79 Q
80 ;
81HELP(CALL) ;General help text routine
82 N HTEXT
83 I CALL=1 D
84 .S HTEXT(1)="Select DR to display or edit a rule."
85 .S HTEXT(2)="Select ED to edit a rule"
86 ;
87 D HELP^PXRMEUT(.HTEXT)
88 Q
89 ;
90EFADD ;Add Rule Option
91 ;
92 ;Reset Screen Mode
93 W IORESET
94 ;
95 ;Add Rule
96 D ADD^PXRMEFED
97 ;
98 ;Rebuild Workfile
99 D BLDLIST
100 ;
101 S VALMBCK="R"
102 Q
103 ;
104EFINQ ;Extract Finding Inquiry - PXRM EXTRACT FINDINQ DISPLAY/EDIT entry
105 N IND,FRIEN,VALMY
106 D EN^VALM2(XQORNOD(0))
107 ;
108 ;If there is no list quit.
109 I '$D(VALMY) Q
110 S PXRMDONE=0
111 S IND=""
112 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
113 .;Get the ien.
114 .S FRIEN=^TMP("PXRMEFM",$J,"IDX",IND,IND)
115 .D START^PXRMEFED(FRIEN)
116 ;
117 D BLDLIST
118 ;
119 S VALMBCK="R"
120 Q
121 ;
122LIST(RLIST,IEN,PIEN) ;Build a list of extract findings for parameter.
123 N EPCLASS,IND,FNAME,NAME,PLIST
124 ;Build the list in alphabetical order.
125 S VALMCNT=0
126 S NAME=""
127 F S NAME=$O(^PXRM(810.7,"B",NAME)) Q:NAME="" D
128 .S IND=$O(^PXRM(810.7,"B",NAME,"")) Q:'IND
129 .S FNAME=$P($G(^PXRM(810.7,IND,0)),U)
130 .S EPCLASS=$P($G(^PXRM(810.7,IND,100)),U)
131 .S VALMCNT=VALMCNT+1
132 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,FNAME,EPCLASS)
133 .S IEN(VALMCNT)=IND
134 S RLIST("VALMCNT")=VALMCNT
135 Q
136 ;
137FRE(NUMBER,NAME,CLASS) ;Format entry number, name
138 ;and date packed.
139 N TCLASS,TEMP,TNAME,TSOURCE
140 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
141 S TNAME=$E(NAME,1,46)
142 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
143 S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
144 S TEMP=TEMP_" "_TCLASS
145 Q TEMP
146 ;
Note: See TracBrowser for help on using the repository browser.