IBDFDE42.m

IBDFDE42 ;ALB/AAS - AICS Data Entry, check selection rules ; 24-FEB-96

 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 ;

% G ^IBDFDE

 ;

CHK ; -- see if rules allow for more or less than one

 ;    rules 0 := select any number

 ;          1 := exactly 1

 ;          2 := at most 1

 ;          3 := at least 1 (1 or more)

 N I,IBDY,MATCH

 S (MATCH,OVER,ASKOTHER)=0

 ;

 ; -- find all matches

 S MATCH=0

 S IBDY=0 F  S IBDY=$O(IBDPI(IBDF("PI"),IBDY)) Q:'IBDY  S MATCH=MATCH+1

 ;

 ; -- any number allowed

 I RULE=0 D

 .I ANS="" S OVER=0 Q  ;nothing selected, don't reask

 .I ANS'="" S OVER=1 Q  ;something selected, reask

 ;

 ; -- exactly one required

 I RULE=1 D

 .I MATCH>1 S OVER=2 W:'$G(IBDREDIT) !,"More than one selected, you must delete one" Q

 .I MATCH=1 S OVER=0 Q  ;exactly one selected

 .I MATCH<1 S OVER=1 W:'$G(IBDREDIT) !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",! Q

 ;

 ; -- at most one required

 I RULE=2 D

 .I MATCH>1 S OVER=2 W:'$G(IBDREDIT) !,"More than one selected, you must delete one" Q

 .I MATCH=1 S OVER=0 Q  ;exactly one selected

 .I ANS'="",MATCH<1 S OVER=1 ;if match = 0 thats okay but ask

 ;

 ; -- at least one required

 I RULE=3 D

 .S OVER=1

 .I MATCH<1 S OVER=1 W:'$G(IBDREDIT) !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",! Q

 .I MATCH>1,ANS="" S OVER=0 Q  ;more than one selected

 .I MATCH=1,ANS="" S OVER=0 Q  ;exactly one selected

 ;

 I OVER=2 D DEL^IBDFDE1

 D DELQLF

CHKQ Q

 ;

DELQLF ; -- delete choices if selected

 Q:(+$G(SEL)=0)

 K ^TMP("IBD-LST",$J,IBDFMIEN,IBDF("PI"),IBDF("IEN"),+$G(SEL))

 Q

IBDFDE42  ;ALB/AAS - AICS Data Entry, check selection rules ; 24-FEB-96

 +1       ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997

 +2       ;

%          GOTO ^IBDFDE

 +1       ;

CHK       ; -- see if rules allow for more or less than one

 +1       ;    rules 0 := select any number

 +2       ;          1 := exactly 1

 +3       ;          2 := at most 1

 +4       ;          3 := at least 1 (1 or more)

 +5        NEW I,IBDY,MATCH

 +6        SET (MATCH,OVER,ASKOTHER)=0

 +7       ;

 +8       ; -- find all matches

 +9        SET MATCH=0

 +10       SET IBDY=0

           FOR 

               SET IBDY=$ORDER(IBDPI(IBDF("PI"),IBDY))

               IF 'IBDY

                   QUIT 

               SET MATCH=MATCH+1

 +11      ;

 +12      ; -- any number allowed

 +13       IF RULE=0

               Begin DoDot:1

 +14      ;nothing selected, don't reask

                   IF ANS=""

                       SET OVER=0

                       QUIT 

 +15      ;something selected, reask

                   IF ANS'=""

                       SET OVER=1

                       QUIT 

               End DoDot:1

 +16      ;

 +17      ; -- exactly one required

 +18       IF RULE=1

               Begin DoDot:1

 +19               IF MATCH>1

                       SET OVER=2

                       IF '$GET(IBDREDIT)

                           WRITE !,"More than one selected, you must delete one"

                       QUIT 

 +20      ;exactly one selected

                   IF MATCH=1

                       SET OVER=0

                       QUIT 

 +21               IF MATCH<1

                       SET OVER=1

                       IF '$GET(IBDREDIT)

                           WRITE !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",!

                       QUIT 

               End DoDot:1

 +22      ;

 +23      ; -- at most one required

 +24       IF RULE=2

               Begin DoDot:1

 +25               IF MATCH>1

                       SET OVER=2

                       IF '$GET(IBDREDIT)

                           WRITE !,"More than one selected, you must delete one"

                       QUIT 

 +26      ;exactly one selected

                   IF MATCH=1

                       SET OVER=0

                       QUIT 

 +27      ;if match = 0 thats okay but ask

                   IF ANS'=""

                       IF MATCH<1

                           SET OVER=1

               End DoDot:1

 +28      ;

 +29      ; -- at least one required

 +30       IF RULE=3

               Begin DoDot:1

 +31               SET OVER=1

 +32               IF MATCH<1

                       SET OVER=1

                       IF '$GET(IBDREDIT)

                           WRITE !!,"A ",IOINHI,IBDASK,IOINORM," selection is required.",!

                       QUIT 

 +33      ;more than one selected

                   IF MATCH>1

                       IF ANS=""

                           SET OVER=0

                           QUIT 

 +34      ;exactly one selected

                   IF MATCH=1

                       IF ANS=""

                           SET OVER=0

                           QUIT 

               End DoDot:1

 +35      ;

 +36       IF OVER=2

               DO DEL^IBDFDE1

 +37       DO DELQLF

CHKQ       QUIT 

 +1       ;

DELQLF    ; -- delete choices if selected

 +1        IF (+$GET(SEL)=0)

               QUIT 

 +2        KILL ^TMP("IBD-LST",$JOB,IBDFMIEN,IBDF("PI"),IBDF("IEN"),+$GET(SEL))

 +3        QUIT