source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEGM.m@ 1766

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PXRMEGM ; SLC/PKR/PJH - Extract Counting Group Management ;08/03/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Main entry point for PXRM EXTRACT COUNTING GROUPS
5START(EFIEN) ;
6 N EFCLASS,EFNAME,PXRMDONE,GROUP
7 N VALMBCK,VALMCNT,VALMSG,X,XMZ,XQORM,XQORNOD
8 S X="IORESET"
9 D ENDR^%ZISS
10 S VALMCNT=0
11 I EFIEN D
12 .S EFNAME=$P($G(^PXRM(810.7,EFIEN,0)),U)
13 .S EFCLASS=$P($G(^PXRM(810.7,EFIEN,100)),U)
14 .S EFCLASS=$S(EFCLASS="N":"National",EFCLASS="V":"VISN",1:"Local")
15 D EN^VALM("PXRM EXTRACT COUNTING GROUPS")
16 Q
17 ;
18BLDLIST ;Build workfile
19 K ^TMP("PXRMEGM",$J)
20 N IEN,IND,PLIST
21 D LIST(.PLIST,.IEN,EFIEN)
22 M ^TMP("PXRMEGM",$J)=PLIST
23 S VALMCNT=PLIST("VALMCNT")
24 F IND=1:1:VALMCNT D
25 .S ^TMP("PXRMEGM",$J,"IDX",IND,IND)=IEN(IND)
26 Q
27 ;
28ENTRY ;Entry code
29 D BLDLIST,XQORM
30 Q
31 ;
32EXIT ;Exit code
33 K ^TMP("PXRMEGM",$J)
34 K ^TMP("PXRMEGMH",$J)
35 D CLEAN^VALM10
36 D FULL^VALM1
37 S VALMBCK="Q"
38 Q
39 ;
40HDR ; Header code
41 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" Q:'EFIEN
42 S VALMHDR(1)="Extract Finding: "_EFNAME
43 S VALMHDR(2)=" Class: "_EFCLASS
44 Q
45 ;
46HLP ;Help code
47 N ORU,ORUPRMT,SUB,XQORM
48 S SUB="PXRMEGMH"
49 D EN^VALM("PXRM EXTRACT HELP")
50 Q
51 ;
52INIT ;Init
53 S VALMCNT=0
54 Q
55 ;
56PEXIT ;Protocol exit code
57 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
58 ;Reset after page up/down etc
59 D XQORM
60 Q
61 ;
62XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM EXTRACT COUNTING GROUP SELECT ENTRY",0))_U_"1:"_VALMCNT
63 S XQORM("A")="Select Item: "
64 Q
65 ;
66XSEL ;PXRM EXTRACT COUNTING GROUP SELECT ENTRY validation
67 N SEL,IEN
68 S SEL=$P(XQORNOD(0),"=",2)
69 ;Remove trailing ,
70 I $E(SEL,$L(SEL))="," S SEL=$E(SEL,1,$L(SEL)-1)
71 ;Invalid selection
72 I SEL["," D Q
73 .W $C(7),!,"Only one item number allowed." H 2
74 .S VALMBCK="R"
75 I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
76 .W $C(7),!,SEL_" is not a valid item number." H 2
77 .S VALMBCK="R"
78 ;
79 ;Get the list ien.
80 S IEN=^TMP("PXRMEGM",$J,"IDX",SEL,SEL)
81 ;Display/Edit Extract Counting Group
82 D START^PXRMEGED(IEN)
83 ;
84 D BLDLIST
85 ;
86 S VALMBCK="R"
87 Q
88 ;
89HELP(CALL) ;General help text routine
90 N HTEXT
91 I CALL=1 D
92 .S HTEXT(1)="Select DE to display or edit a rule."
93 .S HTEXT(2)="Select ED to edit a rule"
94 ;
95 D HELP^PXRMEUT(.HTEXT)
96 Q
97 ;
98EGADD ;Add Rule Option
99 ;
100 ;Reset Screen Mode
101 W IORESET
102 ;
103 ;Add Rule
104 D ADD^PXRMEGED
105 ;
106 ;Rebuild Workfile
107 D BLDLIST
108 ;
109 S VALMBCK="R"
110 Q
111 ;
112EGINQ ;Counting Group Inquiry - PXRM EXTRACT COUNTING GROUP DISPLAY/EDIT entry
113 N IND,FGIEN,VALMY
114 D EN^VALM2(XQORNOD(0))
115 ;
116 ;If there is no list quit.
117 I '$D(VALMY) Q
118 S PXRMDONE=0
119 S IND=""
120 F S IND=$O(VALMY(IND)) Q:(+IND=0)!(PXRMDONE) D
121 .;Get the ien.
122 .S FGIEN=^TMP("PXRMEGM",$J,"IDX",IND,IND)
123 .D START^PXRMEGED(FGIEN)
124 ;
125 D BLDLIST
126 ;
127 S VALMBCK="R"
128 Q
129 ;
130LIST(RLIST,IEN,EFIEN) ;Build a list of extract counting groups for
131 ;extract definition.
132 N EPCLASS,IND,FNAME,NAME,PLIST
133 ;If called for a selected extract finding build list of groups
134 I EFIEN D
135 .N SUB,FGIEN
136 .S SUB=0
137 .F S SUB=$O(^PXRM(810.7,EFIEN,10,SUB)) Q:'SUB D
138 ..S FGIEN=$P($G(^PXRM(810.7,EFIEN,10,SUB,0)),U,2) Q:'FGIEN
139 ..S GROUP(FGIEN)=""
140 ;
141 ;Build the list in alphabetical order.
142 S VALMCNT=0
143 S NAME=""
144 F S NAME=$O(^PXRM(810.8,"B",NAME)) Q:NAME="" D
145 .S IND=$O(^PXRM(810.8,"B",NAME,"")) Q:'IND
146 .;For extract counting rule only include finding counting groups
147 .I EFIEN,'$D(GROUP(IND)) Q
148 .S FNAME=$P($G(^PXRM(810.8,IND,0)),U)
149 .S EPCLASS=$P($G(^PXRM(810.8,IND,100)),U)
150 .S VALMCNT=VALMCNT+1
151 .S RLIST(VALMCNT,0)=$$FRE(VALMCNT,FNAME,EPCLASS)
152 .S IEN(VALMCNT)=IND
153 S RLIST("VALMCNT")=VALMCNT
154 Q
155 ;
156FRE(NUMBER,NAME,CLASS) ;Format entry number, name
157 ;and date packed.
158 N TCLASS,TEMP,TNAME,TSOURCE
159 S TEMP=$$RJ^XLFSTR(NUMBER,5," ")
160 S TNAME=$E(NAME,1,46)
161 S TEMP=TEMP_" "_$$LJ^XLFSTR(TNAME,60," ")
162 S TCLASS=$S(CLASS="N":"NATIONAL",CLASS="V":"VISN",1:"LOCAL")
163 S TEMP=TEMP_" "_TCLASS
164 Q TEMP
165 ;
Note: See TracBrowser for help on using the repository browser.