source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDCOUR.m@ 776

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SDCOUR ;ALB/RMO - Reader Utilities - Check Out;18 FEB 1993 11:30 am
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4EN(SDNOD0,SDSUB,SDPAR,SDSELDF,SDSELY) ;Select Entities from Secondary List
5 ; Input -- SDNOD0 Selection in XQORNOD0 format
6 ; SDSUB Secondary List Subscript
7 ; SDPAR Selection Parameters (A=Add)
8 ; SDSELDF Selection Default [Optional]
9 ; Output -- SDSELY Selection Array
10 N SDCNT
11 S SDCNT=+$G(^TMP("SDCOIDX",$J,SDSUB,0))
12 I 'SDCNT D G ENQ
13 .I $P(SDNOD0,"^",4)["=" W !,*7,">>> There are no items to select." S SDSELY("ERR")="" D PAUSE^VALM1
14 D SEL(SDNOD0,SDSUB,.SDSELY) G ENQ:$D(SDSELY)
15 S SDSELY($$ASK(SDCNT,SDPAR,$G(SDSELDF)))=""
16ENQ Q
17 ;
18SEL(SDNOD0,SDSUB,SDSELY) ;Process Secondary List Selection
19 ; Input -- SDNOD0 Selection in XQORNOD0 format
20 ; SDSUB Secondary List Subscript
21 ; Output -- SDSELY Selection Array
22 N I,SDBEG,SDEND,SDERR,X,Y
23 S SDBEG=1,SDEND=+$G(^TMP("SDCOIDX",$J,SDSUB,0)) G SELQ:'SDEND
24 S Y=$$PARSE^VALM2(SDNOD0,SDBEG,SDEND)
25 ; -- check was valid entries
26 S SDERR=0
27 F I=1:1 S X=$P(Y,",",I) Q:'X D
28 .I '$O(^TMP("SDCOIDX",$J,SDSUB,X,0))!(X<SDBEG)!(X>SDEND) D
29 ..W !,*7,">>> Selection '",X,"' is not a valid choice."
30 ..S SDERR=1
31 I SDERR S SDSELY("ERR")="" D PAUSE^VALM1 G SELQ
32 ;
33 F I=1:1 S X=$P(Y,",",I) Q:'X S SDSELY(X)=""
34SELQ Q
35 ;
36ASK(SDCNT,SDPAR,SDSELDF) ;Ask user to select from list
37 ; Input -- SDCNT Number of Entities
38 ; SDPAR Selection Parameters (A=Add)
39 ; SDSELDF Selection Default [Optional]
40 ; Output -- Selection
41 N DIR,DIRUT,DTOUT,DUOUT,X,Y
42REASK S DIR("?")="Enter "_$S($G(SDSELDF)]"":"<RETURN> for '"_SDSELDF_"', ",1:"")_$S(SDCNT=1:"1",1:"1-"_SDCNT)_" to Edit"_$S(SDPAR["A":", or 'A' to Add",1:"")
43 S DIR("A")="Enter "_$S(SDCNT=1:"1",1:"1-"_SDCNT)_" to Edit"_$S(SDPAR["A":", or 'A' to Add",1:"")_": "_$S($G(SDSELDF)]"":SDSELDF_"// ",1:"")
44 S DIR(0)="FAO^1:30"
45 D ^DIR I $D(DTOUT)!($D(DUOUT)) S Y="^" G ASKQ
46 S Y=$$UPPER^VALM1(Y)
47 I Y?.N,Y,Y'>SDCNT G ASKQ
48 I SDPAR["A",$E(Y)="A" S Y="Add" G ASKQ
49 I Y="" S Y=$S($G(SDSELDF)]"":SDSELDF,1:"Return") G ASKQ
50 W !!?5,DIR("?"),".",! G REASK
51ASKQ Q $G(Y)
Note: See TracBrowser for help on using the repository browser.