source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDE42.m@ 770

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1IBDFDE42 ;ALB/AAS - AICS Data Entry, check selection rules ; 24-FEB-96
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4% G ^IBDFDE
5 ;
6CHK ; -- see if rules allow for more or less than one
7 ; rules 0 := select any number
8 ; 1 := exactly 1
9 ; 2 := at most 1
10 ; 3 := at least 1 (1 or more)
11 N I,IBDY,MATCH
12 S (MATCH,OVER,ASKOTHER)=0
13 ;
14 ; -- find all matches
15 S MATCH=0
16 S IBDY=0 F S IBDY=$O(IBDPI(IBDF("PI"),IBDY)) Q:'IBDY S MATCH=MATCH+1
17 ;
18 ; -- any number allowed
19 I RULE=0 D
20 .I ANS="" S OVER=0 Q ;nothing selected, don't reask
21 .I ANS'="" S OVER=1 Q ;something selected, reask
22 ;
23 ; -- exactly one required
24 I RULE=1 D
25 .I MATCH>1 S OVER=2 W:'$G(IBDREDIT) !,"More than one selected, you must delete one" Q
26 .I MATCH=1 S OVER=0 Q ;exactly one selected
27 .I MATCH<1 S OVER=1 W:'$G(IBDREDIT) !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",! Q
28 ;
29 ; -- at most one required
30 I RULE=2 D
31 .I MATCH>1 S OVER=2 W:'$G(IBDREDIT) !,"More than one selected, you must delete one" Q
32 .I MATCH=1 S OVER=0 Q ;exactly one selected
33 .I ANS'="",MATCH<1 S OVER=1 ;if match = 0 thats okay but ask
34 ;
35 ; -- at least one required
36 I RULE=3 D
37 .S OVER=1
38 .I MATCH<1 S OVER=1 W:'$G(IBDREDIT) !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",! Q
39 .I MATCH>1,ANS="" S OVER=0 Q ;more than one selected
40 .I MATCH=1,ANS="" S OVER=0 Q ;exactly one selected
41 ;
42 I OVER=2 D DEL^IBDFDE1
43 D DELQLF
44CHKQ Q
45 ;
46DELQLF ; -- delete choices if selected
47 Q:(+$G(SEL)=0)
48 K ^TMP("IBD-LST",$J,IBDFMIEN,IBDF("PI"),IBDF("IEN"),+$G(SEL))
49 Q
Note: See TracBrowser for help on using the repository browser.