source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSU4.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1BPSOSU4 ;BHAM ISC/FCS/DRS/FLS - copied for ECME ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 ;----------------------------------------------------------------------
4 ;----------------------------------------------------------------------
5 ;Standard List PROMPT:
6 ;
7 ;Parameters:
8 ; TYPE - S or M (single or multiple selection)
9 ; LROOT - List global root (eg: "^LIST($J,")
10 ; AROOT - Answer global root (eg: "^LISTANS($J,")
11 ; STITLE - Screen Title
12 ; .PROMPT - List PROMPT Array
13 ; OPTIONAL - 1 or 0 (optional or required)
14 ; PGLEN - Page length
15 ; TIMEOUT - Number of seconds
16 ;
17 ;Returns:
18 ; <null> - Unable to process list
19 ; <Ans> - For TYPE="S", item selected
20 ; <^> - Up-arrow entered
21 ; <^^> - Two up-arrows entered
22 ; <-1> - Timeout occurred
23 ;
24 ;----------------------------------------------------------------------
25LIST(TYPE,LROOT,AROOT,STITLE,PROMPT,OPTIONAL,PGLEN,TIMEOUT) ;EP
26 ;
27 ;Manage local variables
28 N CPAGE,NPAGES,START,END,ANS,NLINES,CHEAD1,CHEAD2,I,CMD
29 ;
30 Q:$G(TYPE)="" ""
31 Q:$G(LROOT)="" ""
32 Q:$G(AROOT)="" ""
33 ;
34 S STITLE=$G(STITLE)
35 S OPTIONAL=+$G(OPTIONAL)
36 S:$G(PGLEN)="" PGLEN=10
37 S:$G(TIMEOUT)="" TIMEOUT=$G(DTIME)
38 ;
39 D INIT
40LP1 D DPAGE
41 S ANS=$$PROMPT()
42 I ANS="?" D DHELP G LP1
43 Q:(TYPE="M")&('OPTIONAL)&(ANS="^")&($D(@($E(AROOT,1,$L(AROOT)-1)_")"))'=0) ANS
44 Q:OPTIONAL&(ANS="^") ANS
45 Q:ANS="^^" ANS
46 Q:ANS="TIMEOUT" -1
47 I ANS="" D NEXTPG G LP1
48 I $E(ANS,1)="P" D JUMPPG G LP1
49 ;
50 I TYPE="S"&(+ANS<1!(+ANS>END)) G LP1
51 I TYPE="S"&(+ANS>0&(+ANS'>END)) S @(AROOT_(+ANS)_")")="" Q ANS
52 I TYPE="M" F I=1:1:$L(ANS,",") D
53 .S CMD=$P(ANS,",",I)
54 .I CMD?1N.N D MARK(CMD) Q
55 .I CMD?1"-".N D UNMARK($P(CMD,"-",2)) Q
56 .I CMD?1N.N1"-"1N.N D RMARK(CMD) Q
57 .I CMD?1"-"1N.N1"-"1N.N D RUNMARK(CMD) Q
58 G LP1
59 ;----------------------------------------------------------------------
60HEADER N LINE
61 W @IOF,!
62 D:STITLE'="" WCENTER^BPSOSU9(STITLE,IOM)
63 D:STITLE'="" WCENTER^BPSOSU9($TR($J("",$L(STITLE))," ","-"),IOM)
64 ;
65 ;DISPLAY PROMPT LINEs
66 S LINE=0
67 F D Q:LINE=""
68 .S LINE=$O(PROMPT(LINE))
69 .Q:LINE=""
70 .W:LINE=1 !!
71 .W PROMPT(LINE),!
72 ;
73 W:$G(CHEAD1)'="" !,?9,CHEAD1,!
74 W:$G(CHEAD2)'="" ?9,CHEAD2
75 Q
76 ;----------------------------------------------------------------------
77INIT N CNSPACES,CNAMES,CDEF,INDEX,COLUMNS
78 S NLINES=+$G(@(LROOT_"0)")) I 'NLINES D Q
79 . D IMPOSS^BPSOSUE("P","TI","0 lines indicated in "_LROOT,,"INIT",$T(+0))
80 S NPAGES=((NLINES-1)\PGLEN)+1
81 S CPAGE=1
82 S COLUMNS=$G(@(LROOT_"""Column HEADERs"""_")"))
83 D:COLUMNS'=""
84 .S (CHEAD1,CHEAD2)=""
85 .S CNSPACES=$P(COLUMNS,"|",1)
86 .S CNAMES=$P(COLUMNS,"|",2)
87 .F INDEX=1:1:$L(CNAMES,",") D
88 ..S CDEF=$P(CNAMES,",",INDEX)
89 ..S CHEAD1=CHEAD1_$S(INDEX=1:"",1:$J("",CNSPACES))_$$LJBF^BPSOSU9($P(CDEF,":",1),$P(CDEF,":",2))
90 ..S CHEAD2=CHEAD2_$S(INDEX=1:"",1:$J("",CNSPACES))_$TR($J("",$P(CDEF,":",2))," ","-")
91 Q
92 ;----------------------------------------------------------------------
93MARK(X) ;
94 Q:X<1!(X>NLINES)
95 S @(AROOT_X_")")=""
96 Q
97 ;----------------------------------------------------------------------
98RMARK(X) ;
99 N START,END,INDEX
100 S START=$P(X,"-",1)
101 S END=$P(X,"-",2)
102 F INDEX=START:1:END D MARK(INDEX)
103 Q
104 ;----------------------------------------------------------------------
105UNMARK(X) ;
106 Q:X<1!(X>NLINES)
107 K @(AROOT_X_")")
108 Q
109 ;----------------------------------------------------------------------
110RUNMARK(X) ;
111 N START,END,INDEX
112 S START=$P(X,"-",2)
113 S END=$P(X,"-",3)
114 F INDEX=START:1:END D UNMARK(INDEX)
115 Q
116 ;----------------------------------------------------------------------
117DPAGE N LNUM
118 D HEADER
119 W !
120 S START=((CPAGE-1)*PGLEN)+1
121 S END=START+PGLEN-1
122 S:END>NLINES END=NLINES
123 F LNUM=START:1:END D
124 .W $S($D(@(AROOT_LNUM_")")):"*",1:" ")
125 .W $J(LNUM,5)," - "
126 .W $G(@(LROOT_LNUM_","_"""E"""_")")),!
127 Q
128 ;----------------------------------------------------------------------
129PROMPT() ;
130 W:TYPE="S" !,"[Page "_CPAGE_" of "_NPAGES_"] Commands: #, P#, <Enter>, ^, ^^ or ?",!
131 W:TYPE="M" !,"[Page "_CPAGE_" of "_NPAGES_"] Commands: #, -#, #-#, -#-#, P#, <Enter>, ^, ^^ or ?",!
132 W "Select Item #: "
133 R ANS:TIMEOUT
134 I '$T S ANS="TIMEOUT"
135 Q ANS
136 ;----------------------------------------------------------------------
137NEXTPG S CPAGE=CPAGE+1
138 S:CPAGE>NPAGES CPAGE=NPAGES
139 Q
140 ;----------------------------------------------------------------------
141JUMPPG N NUM
142 Q:$E(ANS,1)'="P"
143 S NUM=+$P(ANS,"P",2)
144 Q:NUM<1!(NUM>NPAGES)
145 S CPAGE=NUM
146 Q
147 ;----------------------------------------------------------------------
148DHELP ;
149 N X
150 W !!,"Enter one of the following commands:",!!
151 W ?10,"#",?20,"- Selects entry number # from the list",!
152 W:TYPE="M" ?10,"-#",?20,"- Deselects entry number # from the list",!
153 W:TYPE="M" ?10,"#-#",?20,"- Selects the range of entries # thru #",!
154 W:TYPE="M" ?10,"-#-#",?20,"- Deselects the range of entries # thru #",!
155 W:TYPE="M"!(TYPE="S"&(OPTIONAL)) ?10,"^",?20,"- Exit the list",!
156 W ?10,"P#",?20,"- Jumps to page number #",!
157 W ?10,"<Enter>",?20,"- DISPLAYs next page",!
158 W ?10,"^^",?20,"- Aborts and returns to menu",!
159 W ?10,"?",?20,"- DISPLAYs this help text",!!
160 D PRESSANY^BPSOSU5(0,TIMEOUT)
161 Q
Note: See TracBrowser for help on using the repository browser.