Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSOSU4

BPSOSU4.m

Go to the documentation of this file. 
  1. BPSOSU4 ;BHAM ISC/FCS/DRS/FLS - copied for ECME ;03/07/08  10:38
  1.  ;;1.0;E CLAIMS MGMT ENGINE;**1,7**;JUN 2004;Build 46
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;----------------------------------------------------------------------
  1.  ;Standard List PROMPT:
  1.  ;
  1.  ;Parameters:
  1.  ;   TYPE     - S or M (single or multiple selection)
  1.  ;   LROOT    - List global root (eg: "^LIST($J,")
  1.  ;   AROOT    - Answer global root (eg: "^LISTANS($J,")
  1.  ;   STITLE   - Screen Title
  1.  ;   .PROMPT  - List PROMPT Array
  1.  ;   OPTIONAL - 1 or 0 (optional or required)
  1.  ;   PGLEN    - Page length
  1.  ;   TIMEOUT  - Number of seconds
  1.  ;
  1.  ;Returns:
  1.  ;   <null>   - Unable to process list
  1.  ;   <Ans>    - For TYPE="S", item selected
  1.  ;   <^>      - Up-arrow entered
  1.  ;   <^^>     - Two up-arrows entered
  1.  ;   <-1>     - Timeout occurred
  1.  ;
  1.  ;----------------------------------------------------------------------
  1. LIST(TYPE,LROOT,AROOT,STITLE,PROMPT,OPTIONAL,PGLEN,TIMEOUT) ;EP
  1.  ;
  1.  ;Manage local variables
  1.  N CPAGE,NPAGES,START,END,ANS,NLINES,CHEAD1,CHEAD2,I,CMD
  1.  ;
  1.  Q:$G(TYPE)="" ""
  1.  Q:$G(LROOT)="" ""
  1.  Q:$G(AROOT)="" ""
  1.  ;
  1.  S STITLE=$G(STITLE)
  1.  S OPTIONAL=+$G(OPTIONAL)
  1.  S:$G(PGLEN)="" PGLEN=10
  1.  S:$G(TIMEOUT)="" TIMEOUT=$G(DTIME)
  1.  ;
  1.  D INIT
  1. LP1 D DPAGE
  1.  S ANS=$$PROMPT()
  1.  I ANS="?" D DHELP G LP1
  1.  Q:(TYPE="M")&('OPTIONAL)&(ANS="^")&($D(@($E(AROOT,1,$L(AROOT)-1)_")"))'=0) ANS
  1.  Q:OPTIONAL&(ANS="^") ANS
  1.  Q:ANS="^^" ANS
  1.  Q:ANS="TIMEOUT" -1
  1.  I ANS="" D NEXTPG G LP1
  1.  I $E(ANS,1)="P" D JUMPPG G LP1
  1.  ;
  1.  I TYPE="S"&(+ANS<1!(+ANS>END)) G LP1
  1.  I TYPE="S"&(+ANS>0&(+ANS'>END)) S @(AROOT_(+ANS)_")")="" Q ANS
  1.  I TYPE="M" F I=1:1:$L(ANS,",") D
  1.  .S CMD=$P(ANS,",",I)
  1.  .I CMD?1N.N D MARK(CMD) Q
  1.  .I CMD?1"-".N D UNMARK($P(CMD,"-",2)) Q
  1.  .I CMD?1N.N1"-"1N.N D RMARK(CMD) Q
  1.  .I CMD?1"-"1N.N1"-"1N.N D RUNMARK(CMD) Q
  1.  G LP1
  1.  ;----------------------------------------------------------------------
  1.  W @IOF,!
  1.  D:STITLE'="" WCENTER^BPSOSU9(STITLE,IOM)
  1.  D:STITLE'="" WCENTER^BPSOSU9($TR($J("",$L(STITLE))," ","-"),IOM)
  1.  ;
  1.  ;DISPLAY PROMPT LINEs
  1.  S LINE=0
  1.  F  D  Q:LINE=""
  1.  .S LINE=$O(PROMPT(LINE))
  1.  .Q:LINE=""
  1.  .W:LINE=1 !!
  1.  .W PROMPT(LINE),!
  1.  ;
  1.  W:$G(CHEAD1)'="" !,?9,CHEAD1,!
  1.  W:$G(CHEAD2)'="" ?9,CHEAD2
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. INIT N CNSPACES,CNAMES,CDEF,INDEX,COLUMNS
  1.  S NLINES=+$G(@(LROOT_"0)")) I 'NLINES D  Q
  1.  . D IMPOSS^BPSOSUE("P","TI","0 lines indicated in "_LROOT,,"INIT",$T(+0))
  1.  S NPAGES=((NLINES-1)\PGLEN)+1
  1.  S CPAGE=1
  1.  S COLUMNS=$G(@(LROOT_"""Column HEADERs"""_")"))
  1.  D:COLUMNS'=""
  1.  .S (CHEAD1,CHEAD2)=""
  1.  .S CNSPACES=$P(COLUMNS,"|",1)
  1.  .S CNAMES=$P(COLUMNS,"|",2)
  1.  .F INDEX=1:1:$L(CNAMES,",") D
  1.  ..S CDEF=$P(CNAMES,",",INDEX)
  1.  ..S CHEAD1=CHEAD1_$S(INDEX=1:"",1:$J("",CNSPACES))_$$LJBF^BPSOSU9($P(CDEF,":",1),$P(CDEF,":",2))
  1.  ..S CHEAD2=CHEAD2_$S(INDEX=1:"",1:$J("",CNSPACES))_$TR($J("",$P(CDEF,":",2))," ","-")
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. MARK(X) ;
  1.  Q:X<1!(X>NLINES)
  1.  S @(AROOT_X_")")=""
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. RMARK(X) ;
  1.  N START,END,INDEX
  1.  S START=$P(X,"-",1)
  1.  S END=$P(X,"-",2)
  1.  F INDEX=START:1:END D MARK(INDEX)
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. UNMARK(X) ;
  1.  Q:X<1!(X>NLINES)
  1.  K @(AROOT_X_")")
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. RUNMARK(X) ;
  1.  N START,END,INDEX
  1.  S START=$P(X,"-",2)
  1.  S END=$P(X,"-",3)
  1.  F INDEX=START:1:END D UNMARK(INDEX)
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. DPAGE N LNUM
  1.  D HEADER
  1.  W !
  1.  S START=((CPAGE-1)*PGLEN)+1
  1.  S END=START+PGLEN-1
  1.  S:END>NLINES END=NLINES
  1.  F LNUM=START:1:END D
  1.  .W $S($D(@(AROOT_LNUM_")")):"*",1:" ")
  1.  .W $J(LNUM,5)," - "
  1.  .W $G(@(LROOT_LNUM_","_"""E"""_")")),!
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. PROMPT() ;
  1.  W:TYPE="S" !,"[Page "_CPAGE_" of "_NPAGES_"]  Commands: #, P#, <Enter>, ^, ^^ or ?",!
  1.  W:TYPE="M" !,"[Page "_CPAGE_" of "_NPAGES_"]  Commands: #, -#, #-#, -#-#, P#, <Enter>, ^, ^^ or ?",!
  1.  W "Select Item #: "
  1.  R ANS:TIMEOUT
  1.  I '$T S ANS="TIMEOUT"
  1.  Q ANS
  1.  ;----------------------------------------------------------------------
  1. NEXTPG S CPAGE=CPAGE+1
  1.  S:CPAGE>NPAGES CPAGE=NPAGES
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. JUMPPG N NUM
  1.  Q:$E(ANS,1)'="P"
  1.  S NUM=+$P(ANS,"P",2)
  1.  Q:NUM<1!(NUM>NPAGES)
  1.  S CPAGE=NUM
  1.  Q
  1.  ;----------------------------------------------------------------------
  1. DHELP ;
  1.  N X
  1.  W !!,"Enter one of the following commands:",!!
  1.  W ?10,"#",?20,"- Selects entry number # from the list",!
  1.  W:TYPE="M" ?10,"-#",?20,"- Deselects entry number # from the list",!
  1.  W:TYPE="M" ?10,"#-#",?20,"- Selects the range of entries # thru #",!
  1.  W:TYPE="M" ?10,"-#-#",?20,"- Deselects the range of entries # thru #",!
  1.  W:TYPE="M"!(TYPE="S"&(OPTIONAL)) ?10,"^",?20,"- Exit the list",!
  1.  W ?10,"P#",?20,"- Jumps to page number #",!
  1.  W ?10,"<Enter>",?20,"- DISPLAYs next page",!
  1.  W ?10,"^^",?20,"- Aborts and returns to menu",!
  1.  W ?10,"?",?20,"- DISPLAYs this help text",!!
  1.  D PRESSANY^BPSOSU5(0,TIMEOUT)
  1.  Q