source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENLR.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DGENLR ;ALB/RMO - Patient Enrollment - Reader Utilities;26 JUN 1997 10:00 am
2 ;;5.3;Registration;**121**;Aug 13, 1993
3 ;
4EN(DGNOD0,DGSUB,DGSELY) ;select entities from secondary list
5 ; Input -- DGNOD0 Selection in XQORNOD0 format
6 ; DGSUB Secondary list subscript
7 ; Output -- DGSELY Selection array
8 N DGCNT
9 ;
10 ;
11 ;Initialize counter
12 S DGCNT=+$G(^TMP("DGENIDX",$J,DGSUB,0))
13 ;
14 ;Exit if no entries to select
15 I 'DGCNT D G ENQ
16 . I $P(DGNOD0,"^",4)["=" D
17 . . W !,*7,">>> There are no items to select."
18 . . S DGSELY("ERR")=""
19 . . D PAUSE^VALM1
20 ;
21 ;Set selection array if only one entry
22 I DGCNT,DGCNT=1,$P($P(DGNOD0,U,4),"=",2)="" S DGSELY(1)="" G ENQ
23 ;
24 ;determine if display area shows the history - if not, redisplay
25 ;begining at the top of history
26 I DGCNT D
27 .N TOP
28 .S TOP=+$O(^TMP("DGENIDX",$J,"EH",1,0))
29 .I (VALMLST<TOP) D SETTOP(TOP-3)
30 ;
31 ;Process secondary selection list
32 D SEL(DGNOD0,DGSUB,.DGSELY)
33ENQ Q
34 ;
35SEL(DGNOD0,DGSUB,DGSELY) ;Process secondary list selection
36 ; Input -- DGNOD0 Selection in XQORNOD0 format
37 ; DGSUB Secondary list subscript
38 ; Output -- DGSELY Selection array
39 N I,DGBEG,DGEND,DGERR,X,Y
40 ;
41 ;Set begin and end, exit if no entries
42 S DGBEG=1,DGEND=+$G(^TMP("DGENIDX",$J,DGSUB,0)) G SELQ:'DGEND
43 ;
44 ;Process pre-answers from user
45 S Y=$$PARSE^VALM2(DGNOD0,DGBEG,DGEND)
46 ;
47 ;Ask user to select entries
48 I 'Y S Y=$$ASK(DGCNT)
49 ;
50 ;Exit if timeout, '^' or no selection
51 I 'Y S DGSELY("^")="" G SELQ
52 ;
53 ;Check for valid entries
54 S DGERR=0
55 F I=1:1 S X=$P(Y,",",I) Q:'X D
56 . I '$O(^TMP("DGENIDX",$J,DGSUB,X,0))!(X<DGBEG)!(X>DGEND) D
57 . . W !,*7,">>> Selection '",X,"' is not a valid choice."
58 . . S DGERR=1
59 I DGERR S DGSELY("ERR")="" D PAUSE^VALM1 G SELQ
60 ;
61 ;Set selection array
62 F I=1:1 S X=$P(Y,",",I) Q:'X S DGSELY(X)=""
63SELQ Q
64 ;
65ASK(DGCNT) ;Ask user to select from list
66 ; Input -- DGCNT Number of entities
67 ; Output -- Selection
68 N DIR,DIRUT,DTOUT,DUOUT,X,Y,LAST
69 S LAST=$$LAST(DGCNT)
70 S DIR("A")="Select Enrollment(s)"
71 S DIR(0)="L"_U_"1"_":"_$S(LAST:LAST,1:DGCNT)
72 D ^DIR I $D(DTOUT)!($D(DUOUT)) S Y="^" G ASKQ
73ASKQ Q $G(Y)
74 ;
75LAST(DGCNT) ;
76 ;determines number of last history item showing on the secondary
77 ;list
78 ;
79 N LINE,ITEM
80 ;
81 ;if the end of the list is displayed, return DGCNT as the last item displayed
82 Q:($O(^TMP("DGENIDX",$J,"EH",+DGCNT,0))'>VALMLST) DGCNT
83 ;
84 ;otherwise, must determine last item displayed
85 S ITEM=0
86 F S ITEM=$O(^TMP("DGENIDX",$J,"EH",ITEM)) Q:'ITEM S LINE=$O(^(ITEM,0)) I LINE=VALMLST Q
87 Q +ITEM
88 ;
89SETTOP(TOP) ;
90 ;sets top of screen to line=TOP and redisplays it
91 ;
92 N LINE
93 S VALMLST=TOP+(VALMLST-VALMBG)
94 S:(VALMLST>VALMCNT) VALMLST=VALMCNT
95 S VALMBG=TOP
96 F LINE=VALMBG:1:(VALMBG+15-1) D
97 .I LINE'>VALMLST D WRITE^VALM10(LINE)
98 .I LINE>VALMLST D SET^VALM10(LINE," "),WRITE^VALM10(LINE)
99 Q
Note: See TracBrowser for help on using the repository browser.