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

DGENLR.m

Go to the documentation of this file. 
  1. DGENLR ;ALB/RMO - Patient Enrollment - Reader Utilities;26 JUN 1997 10:00 am
  1.  ;;5.3;Registration;**121**;Aug 13, 1993
  1.  ;
  1. EN(DGNOD0,DGSUB,DGSELY) ;select entities from secondary list
  1.  ; Input  -- DGNOD0   Selection in XQORNOD0 format
  1.  ;           DGSUB    Secondary list subscript
  1.  ; Output -- DGSELY   Selection array
  1.  N DGCNT
  1.  ;
  1.  ;
  1.  ;Initialize counter
  1.  S DGCNT=+$G(^TMP("DGENIDX",$J,DGSUB,0))
  1.  ;
  1.  ;Exit if no entries to select
  1.  I 'DGCNT D  G ENQ
  1.  . I $P(DGNOD0,"^",4)["=" D
  1.  . . W !,*7,">>> There are no items to select."
  1.  . . S DGSELY("ERR")=""
  1.  . . D PAUSE^VALM1
  1.  ;
  1.  ;Set selection array if only one entry
  1.  I DGCNT,DGCNT=1,$P($P(DGNOD0,U,4),"=",2)="" S DGSELY(1)="" G ENQ
  1.  ;
  1.  ;determine if display area shows the history - if not, redisplay
  1.  ;begining at the top of history
  1.  I DGCNT D
  1.  .N TOP
  1.  .S TOP=+$O(^TMP("DGENIDX",$J,"EH",1,0))
  1.  .I (VALMLST<TOP) D SETTOP(TOP-3)
  1.  ;
  1.  ;Process secondary selection list
  1.  D SEL(DGNOD0,DGSUB,.DGSELY)
  1. ENQ Q
  1.  ;
  1. SEL(DGNOD0,DGSUB,DGSELY) ;Process secondary list selection
  1.  ; Input  -- DGNOD0   Selection in XQORNOD0 format
  1.  ;           DGSUB    Secondary list subscript
  1.  ; Output -- DGSELY   Selection array
  1.  N I,DGBEG,DGEND,DGERR,X,Y
  1.  ;
  1.  ;Set begin and end, exit if no entries
  1.  S DGBEG=1,DGEND=+$G(^TMP("DGENIDX",$J,DGSUB,0)) G SELQ:'DGEND
  1.  ;
  1.  ;Process pre-answers from user
  1.  S Y=$$PARSE^VALM2(DGNOD0,DGBEG,DGEND)
  1.  ;
  1.  ;Ask user to select entries
  1.  I 'Y S Y=$$ASK(DGCNT)
  1.  ;
  1.  ;Exit if timeout, '^' or no selection
  1.  I 'Y S DGSELY("^")="" G SELQ
  1.  ;
  1.  ;Check for valid entries
  1.  S DGERR=0
  1.  F I=1:1 S X=$P(Y,",",I) Q:'X  D
  1.  . I '$O(^TMP("DGENIDX",$J,DGSUB,X,0))!(X<DGBEG)!(X>DGEND) D
  1.  . . W !,*7,">>> Selection '",X,"' is not a valid choice."
  1.  . . S DGERR=1
  1.  I DGERR S DGSELY("ERR")="" D PAUSE^VALM1 G SELQ
  1.  ;
  1.  ;Set selection array
  1.  F I=1:1 S X=$P(Y,",",I) Q:'X  S DGSELY(X)=""
  1. SELQ Q
  1.  ;
  1. ASK(DGCNT) ;Ask user to select from list
  1.  ; Input  -- DGCNT    Number of entities
  1.  ; Output -- Selection
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y,LAST
  1.  S LAST=$$LAST(DGCNT)
  1.  S DIR("A")="Select Enrollment(s)"
  1.  S DIR(0)="L"_U_"1"_":"_$S(LAST:LAST,1:DGCNT)
  1.  D ^DIR I $D(DTOUT)!($D(DUOUT)) S Y="^" G ASKQ
  1. ASKQ Q $G(Y)
  1.  ;
  1. LAST(DGCNT) ;
  1.  ;determines number of last history item showing on the secondary
  1.  ;list
  1.  ;
  1.  N LINE,ITEM
  1.  ;
  1.  ;if the end of the list is displayed, return DGCNT as the last item displayed
  1.  Q:($O(^TMP("DGENIDX",$J,"EH",+DGCNT,0))'>VALMLST) DGCNT
  1.  ;
  1.  ;otherwise, must determine last item displayed
  1.  S ITEM=0
  1.  F  S ITEM=$O(^TMP("DGENIDX",$J,"EH",ITEM)) Q:'ITEM  S LINE=$O(^(ITEM,0)) I LINE=VALMLST Q
  1.  Q +ITEM
  1.  ;
  1. SETTOP(TOP) ;
  1.  ;sets top of screen to line=TOP and redisplays it
  1.  ;
  1.  N LINE
  1.  S VALMLST=TOP+(VALMLST-VALMBG)
  1.  S:(VALMLST>VALMCNT) VALMLST=VALMCNT
  1.  S VALMBG=TOP
  1.  F LINE=VALMBG:1:(VALMBG+15-1) D
  1.  .I LINE'>VALMLST D WRITE^VALM10(LINE)
  1.  .I LINE>VALMLST D SET^VALM10(LINE," "),WRITE^VALM10(LINE)
  1.  Q