| 1 | BPSOSU4 ;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 | ;---------------------------------------------------------------------- | 
|---|
| 25 | LIST(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 | 
|---|
| 40 | LP1 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 | ;---------------------------------------------------------------------- | 
|---|
| 60 | HEADER 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 | ;---------------------------------------------------------------------- | 
|---|
| 77 | INIT 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 | ;---------------------------------------------------------------------- | 
|---|
| 93 | MARK(X) ; | 
|---|
| 94 | Q:X<1!(X>NLINES) | 
|---|
| 95 | S @(AROOT_X_")")="" | 
|---|
| 96 | Q | 
|---|
| 97 | ;---------------------------------------------------------------------- | 
|---|
| 98 | RMARK(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 | ;---------------------------------------------------------------------- | 
|---|
| 105 | UNMARK(X) ; | 
|---|
| 106 | Q:X<1!(X>NLINES) | 
|---|
| 107 | K @(AROOT_X_")") | 
|---|
| 108 | Q | 
|---|
| 109 | ;---------------------------------------------------------------------- | 
|---|
| 110 | RUNMARK(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 | ;---------------------------------------------------------------------- | 
|---|
| 117 | DPAGE 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 | ;---------------------------------------------------------------------- | 
|---|
| 129 | PROMPT() ; | 
|---|
| 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 | ;---------------------------------------------------------------------- | 
|---|
| 137 | NEXTPG S CPAGE=CPAGE+1 | 
|---|
| 138 | S:CPAGE>NPAGES CPAGE=NPAGES | 
|---|
| 139 | Q | 
|---|
| 140 | ;---------------------------------------------------------------------- | 
|---|
| 141 | JUMPPG 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 | ;---------------------------------------------------------------------- | 
|---|
| 148 | DHELP ; | 
|---|
| 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 | 
|---|