| 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
 | 
|---|