DGENLR ;ALB/RMO - Patient Enrollment - Reader Utilities;26 JUN 1997 10:00 am
;;5.3;Registration;**121**;Aug 13, 1993
;
EN(DGNOD0,DGSUB,DGSELY) ;select entities from secondary list
; Input -- DGNOD0 Selection in XQORNOD0 format
; DGSUB Secondary list subscript
; Output -- DGSELY Selection array
N DGCNT
;
;
;Initialize counter
S DGCNT=+$G(^TMP("DGENIDX",$J,DGSUB,0))
;
;Exit if no entries to select
I 'DGCNT D G ENQ
. I $P(DGNOD0,"^",4)["=" D
. . W !,*7,">>> There are no items to select."
. . S DGSELY("ERR")=""
. . D PAUSE^VALM1
;
;Set selection array if only one entry
I DGCNT,DGCNT=1,$P($P(DGNOD0,U,4),"=",2)="" S DGSELY(1)="" G ENQ
;
;determine if display area shows the history - if not, redisplay
;begining at the top of history
I DGCNT D
.N TOP
.S TOP=+$O(^TMP("DGENIDX",$J,"EH",1,0))
.I (VALMLST<TOP) D SETTOP(TOP-3)
;
;Process secondary selection list
D SEL(DGNOD0,DGSUB,.DGSELY)
ENQ Q
;
SEL(DGNOD0,DGSUB,DGSELY) ;Process secondary list selection
; Input -- DGNOD0 Selection in XQORNOD0 format
; DGSUB Secondary list subscript
; Output -- DGSELY Selection array
N I,DGBEG,DGEND,DGERR,X,Y
;
;Set begin and end, exit if no entries
S DGBEG=1,DGEND=+$G(^TMP("DGENIDX",$J,DGSUB,0)) G SELQ:'DGEND
;
;Process pre-answers from user
S Y=$$PARSE^VALM2(DGNOD0,DGBEG,DGEND)
;
;Ask user to select entries
I 'Y S Y=$$ASK(DGCNT)
;
;Exit if timeout, '^' or no selection
I 'Y S DGSELY("^")="" G SELQ
;
;Check for valid entries
S DGERR=0
F I=1:1 S X=$P(Y,",",I) Q:'X D
. I '$O(^TMP("DGENIDX",$J,DGSUB,X,0))!(X<DGBEG)!(X>DGEND) D
. . W !,*7,">>> Selection '",X,"' is not a valid choice."
. . S DGERR=1
I DGERR S DGSELY("ERR")="" D PAUSE^VALM1 G SELQ
;
;Set selection array
F I=1:1 S X=$P(Y,",",I) Q:'X S DGSELY(X)=""
SELQ Q
;
ASK(DGCNT) ;Ask user to select from list
; Input -- DGCNT Number of entities
; Output -- Selection
N DIR,DIRUT,DTOUT,DUOUT,X,Y,LAST
S LAST=$$LAST(DGCNT)
S DIR("A")="Select Enrollment(s)"
S DIR(0)="L"_U_"1"_":"_$S(LAST:LAST,1:DGCNT)
D ^DIR I $D(DTOUT)!($D(DUOUT)) S Y="^" G ASKQ
ASKQ Q $G(Y)
;
LAST(DGCNT) ;
;determines number of last history item showing on the secondary
;list
;
N LINE,ITEM
;
;if the end of the list is displayed, return DGCNT as the last item displayed
Q:($O(^TMP("DGENIDX",$J,"EH",+DGCNT,0))'>VALMLST) DGCNT
;
;otherwise, must determine last item displayed
S ITEM=0
F S ITEM=$O(^TMP("DGENIDX",$J,"EH",ITEM)) Q:'ITEM S LINE=$O(^(ITEM,0)) I LINE=VALMLST Q
Q +ITEM
;
SETTOP(TOP) ;
;sets top of screen to line=TOP and redisplays it
;
N LINE
S VALMLST=TOP+(VALMLST-VALMBG)
S:(VALMLST>VALMCNT) VALMLST=VALMCNT
S VALMBG=TOP
F LINE=VALMBG:1:(VALMBG+15-1) D
.I LINE'>VALMLST D WRITE^VALM10(LINE)
.I LINE>VALMLST D SET^VALM10(LINE," "),WRITE^VALM10(LINE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENLR 2918 printed Oct 16, 2024@18:43:29 Page 2
DGENLR ;ALB/RMO - Patient Enrollment - Reader Utilities;26 JUN 1997 10:00 am
+1 ;;5.3;Registration;**121**;Aug 13, 1993
+2 ;
EN(DGNOD0,DGSUB,DGSELY) ;select entities from secondary list
+1 ; Input -- DGNOD0 Selection in XQORNOD0 format
+2 ; DGSUB Secondary list subscript
+3 ; Output -- DGSELY Selection array
+4 NEW DGCNT
+5 ;
+6 ;
+7 ;Initialize counter
+8 SET DGCNT=+$GET(^TMP("DGENIDX",$JOB,DGSUB,0))
+9 ;
+10 ;Exit if no entries to select
+11 IF 'DGCNT
Begin DoDot:1
+12 IF $PIECE(DGNOD0,"^",4)["="
Begin DoDot:2
+13 WRITE !,*7,">>> There are no items to select."
+14 SET DGSELY("ERR")=""
+15 DO PAUSE^VALM1
End DoDot:2
End DoDot:1
GOTO ENQ
+16 ;
+17 ;Set selection array if only one entry
+18 IF DGCNT
IF DGCNT=1
IF $PIECE($PIECE(DGNOD0,U,4),"=",2)=""
SET DGSELY(1)=""
GOTO ENQ
+19 ;
+20 ;determine if display area shows the history - if not, redisplay
+21 ;begining at the top of history
+22 IF DGCNT
Begin DoDot:1
+23 NEW TOP
+24 SET TOP=+$ORDER(^TMP("DGENIDX",$JOB,"EH",1,0))
+25 IF (VALMLST<TOP)
DO SETTOP(TOP-3)
End DoDot:1
+26 ;
+27 ;Process secondary selection list
+28 DO SEL(DGNOD0,DGSUB,.DGSELY)
ENQ QUIT
+1 ;
SEL(DGNOD0,DGSUB,DGSELY) ;Process secondary list selection
+1 ; Input -- DGNOD0 Selection in XQORNOD0 format
+2 ; DGSUB Secondary list subscript
+3 ; Output -- DGSELY Selection array
+4 NEW I,DGBEG,DGEND,DGERR,X,Y
+5 ;
+6 ;Set begin and end, exit if no entries
+7 SET DGBEG=1
SET DGEND=+$GET(^TMP("DGENIDX",$JOB,DGSUB,0))
if 'DGEND
GOTO SELQ
+8 ;
+9 ;Process pre-answers from user
+10 SET Y=$$PARSE^VALM2(DGNOD0,DGBEG,DGEND)
+11 ;
+12 ;Ask user to select entries
+13 IF 'Y
SET Y=$$ASK(DGCNT)
+14 ;
+15 ;Exit if timeout, '^' or no selection
+16 IF 'Y
SET DGSELY("^")=""
GOTO SELQ
+17 ;
+18 ;Check for valid entries
+19 SET DGERR=0
+20 FOR I=1:1
SET X=$PIECE(Y,",",I)
if 'X
QUIT
Begin DoDot:1
+21 IF '$ORDER(^TMP("DGENIDX",$JOB,DGSUB,X,0))!(X<DGBEG)!(X>DGEND)
Begin DoDot:2
+22 WRITE !,*7,">>> Selection '",X,"' is not a valid choice."
+23 SET DGERR=1
End DoDot:2
End DoDot:1
+24 IF DGERR
SET DGSELY("ERR")=""
DO PAUSE^VALM1
GOTO SELQ
+25 ;
+26 ;Set selection array
+27 FOR I=1:1
SET X=$PIECE(Y,",",I)
if 'X
QUIT
SET DGSELY(X)=""
SELQ QUIT
+1 ;
ASK(DGCNT) ;Ask user to select from list
+1 ; Input -- DGCNT Number of entities
+2 ; Output -- Selection
+3 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,LAST
+4 SET LAST=$$LAST(DGCNT)
+5 SET DIR("A")="Select Enrollment(s)"
+6 SET DIR(0)="L"_U_"1"_":"_$SELECT(LAST:LAST,1:DGCNT)
+7 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET Y="^"
GOTO ASKQ
ASKQ QUIT $GET(Y)
+1 ;
LAST(DGCNT) ;
+1 ;determines number of last history item showing on the secondary
+2 ;list
+3 ;
+4 NEW LINE,ITEM
+5 ;
+6 ;if the end of the list is displayed, return DGCNT as the last item displayed
+7 if ($ORDER(^TMP("DGENIDX",$JOB,"EH",+DGCNT,0))'>VALMLST)
QUIT DGCNT
+8 ;
+9 ;otherwise, must determine last item displayed
+10 SET ITEM=0
+11 FOR
SET ITEM=$ORDER(^TMP("DGENIDX",$JOB,"EH",ITEM))
if 'ITEM
QUIT
SET LINE=$ORDER(^(ITEM,0))
IF LINE=VALMLST
QUIT
+12 QUIT +ITEM
+13 ;
SETTOP(TOP) ;
+1 ;sets top of screen to line=TOP and redisplays it
+2 ;
+3 NEW LINE
+4 SET VALMLST=TOP+(VALMLST-VALMBG)
+5 if (VALMLST>VALMCNT)
SET VALMLST=VALMCNT
+6 SET VALMBG=TOP
+7 FOR LINE=VALMBG:1:(VALMBG+15-1)
Begin DoDot:1
+8 IF LINE'>VALMLST
DO WRITE^VALM10(LINE)
+9 IF LINE>VALMLST
DO SET^VALM10(LINE," ")
DO WRITE^VALM10(LINE)
End DoDot:1
+10 QUIT
