SDCOUR.m

SDCOUR ;ALB/RMO - Reader Utilities - Check Out;18 FEB 1993 11:30 am

 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 ;

EN(SDNOD0,SDSUB,SDPAR,SDSELDF,SDSELY) ;Select Entities from Secondary List

 ; Input  -- SDNOD0   Selection in XQORNOD0 format

 ;           SDSUB    Secondary List Subscript

 ;           SDPAR    Selection Parameters (A=Add)

 ;           SDSELDF  Selection Default  [Optional]

 ; Output -- SDSELY   Selection Array

 N SDCNT

 S SDCNT=+$G(^TMP("SDCOIDX",$J,SDSUB,0))

 I 'SDCNT D  G ENQ

 .I $P(SDNOD0,"^",4)["=" W !,*7,">>> There are no items to select." S SDSELY("ERR")="" D PAUSE^VALM1

 D SEL(SDNOD0,SDSUB,.SDSELY) G ENQ:$D(SDSELY)

 S SDSELY($$ASK(SDCNT,SDPAR,$G(SDSELDF)))=""

ENQ Q

 ;

SEL(SDNOD0,SDSUB,SDSELY) ;Process Secondary List Selection

 ; Input  -- SDNOD0   Selection in XQORNOD0 format

 ;           SDSUB    Secondary List Subscript

 ; Output -- SDSELY   Selection Array

 N I,SDBEG,SDEND,SDERR,X,Y

 S SDBEG=1,SDEND=+$G(^TMP("SDCOIDX",$J,SDSUB,0)) G SELQ:'SDEND

 S Y=$$PARSE^VALM2(SDNOD0,SDBEG,SDEND)

 ; -- check was valid entries

 S SDERR=0

 F I=1:1 S X=$P(Y,",",I) Q:'X  D

 .I '$O(^TMP("SDCOIDX",$J,SDSUB,X,0))!(X<SDBEG)!(X>SDEND) D

 ..W !,*7,">>> Selection '",X,"' is not a valid choice."

 ..S SDERR=1

 I SDERR S SDSELY("ERR")="" D PAUSE^VALM1 G SELQ

 ;

 F I=1:1 S X=$P(Y,",",I) Q:'X  S SDSELY(X)=""

SELQ Q

 ;

ASK(SDCNT,SDPAR,SDSELDF) ;Ask user to select from list

 ; Input  -- SDCNT    Number of Entities

 ;           SDPAR    Selection Parameters (A=Add)

 ;           SDSELDF  Selection Default  [Optional]

 ; Output -- Selection

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

REASK 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:"")

 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:"")

 S DIR(0)="FAO^1:30"

 D ^DIR I $D(DTOUT)!($D(DUOUT)) S Y="^" G ASKQ

 S Y=$$UPPER^VALM1(Y)

 I Y?.N,Y,Y'>SDCNT G ASKQ

 I SDPAR["A",$E(Y)="A" S Y="Add" G ASKQ

 I Y="" S Y=$S($G(SDSELDF)]"":SDSELDF,1:"Return") G ASKQ

 W !!?5,DIR("?"),".",! G REASK

ASKQ Q $G(Y)

SDCOUR    ;ALB/RMO - Reader Utilities - Check Out;18 FEB 1993 11:30 am

 +1       ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 +2       ;

EN(SDNOD0,SDSUB,SDPAR,SDSELDF,SDSELY) ;Select Entities from Secondary List

 +1       ; Input  -- SDNOD0   Selection in XQORNOD0 format

 +2       ;           SDSUB    Secondary List Subscript

 +3       ;           SDPAR    Selection Parameters (A=Add)

 +4       ;           SDSELDF  Selection Default  [Optional]

 +5       ; Output -- SDSELY   Selection Array

 +6        NEW SDCNT

 +7        SET SDCNT=+$GET(^TMP("SDCOIDX",$JOB,SDSUB,0))

 +8        IF 'SDCNT

               Begin DoDot:1

 +9                IF $PIECE(SDNOD0,"^",4)["="

                       WRITE !,*7,">>> There are no items to select."

                       SET SDSELY("ERR")=""

                       DO PAUSE^VALM1

               End DoDot:1

               GOTO ENQ

 +10       DO SEL(SDNOD0,SDSUB,.SDSELY)

           IF $DATA(SDSELY)

               GOTO ENQ

 +11       SET SDSELY($$ASK(SDCNT,SDPAR,$GET(SDSELDF)))=""

ENQ        QUIT 

 +1       ;

SEL(SDNOD0,SDSUB,SDSELY) ;Process Secondary List Selection

 +1       ; Input  -- SDNOD0   Selection in XQORNOD0 format

 +2       ;           SDSUB    Secondary List Subscript

 +3       ; Output -- SDSELY   Selection Array

 +4        NEW I,SDBEG,SDEND,SDERR,X,Y

 +5        SET SDBEG=1

           SET SDEND=+$GET(^TMP("SDCOIDX",$JOB,SDSUB,0))

           IF 'SDEND

               GOTO SELQ

 +6        SET Y=$$PARSE^VALM2(SDNOD0,SDBEG,SDEND)

 +7       ; -- check was valid entries

 +8        SET SDERR=0

 +9        FOR I=1:1

               SET X=$PIECE(Y,",",I)

               IF 'X

                   QUIT 

               Begin DoDot:1

 +10               IF '$ORDER(^TMP("SDCOIDX",$JOB,SDSUB,X,0))!(X<SDBEG)!(X>SDEND)

                       Begin DoDot:2

 +11                       WRITE !,*7,">>> Selection '",X,"' is not a valid choice."

 +12                       SET SDERR=1

                       End DoDot:2

               End DoDot:1

 +13       IF SDERR

               SET SDSELY("ERR")=""

               DO PAUSE^VALM1

               GOTO SELQ

 +14      ;

 +15       FOR I=1:1

               SET X=$PIECE(Y,",",I)

               IF 'X

                   QUIT 

               SET SDSELY(X)=""

SELQ       QUIT 

 +1       ;

ASK(SDCNT,SDPAR,SDSELDF) ;Ask user to select from list

 +1       ; Input  -- SDCNT    Number of Entities

 +2       ;           SDPAR    Selection Parameters (A=Add)

 +3       ;           SDSELDF  Selection Default  [Optional]

 +4       ; Output -- Selection

 +5        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

REASK      SET DIR("?")="Enter "_$SELECT($GET(SDSELDF)]"":"<RETURN> for '"_SDSELDF_"', ",1:"")_$SELECT(SDCNT=1:"1",1:"1-"_SDCNT)_" to Edit"_$SELECT(SDPAR["A":", or 'A' to Add",1:"")

 +1        SET DIR("A")="Enter "_$SELECT(SDCNT=1:"1",1:"1-"_SDCNT)_" to Edit"_$SELECT(SDPAR["A":", or 'A' to Add",1:"")_": "_$SELECT($GET(SDSELDF)]"":SDSELDF_"// ",1:"")

 +2        SET DIR(0)="FAO^1:30"

 +3        DO ^DIR

           IF $DATA(DTOUT)!($DATA(DUOUT))

               SET Y="^"

               GOTO ASKQ

 +4        SET Y=$$UPPER^VALM1(Y)

 +5        IF Y?.N

               IF Y

                   IF Y'>SDCNT

                       GOTO ASKQ

 +6        IF SDPAR["A"

               IF $EXTRACT(Y)="A"

                   SET Y="Add"

                   GOTO ASKQ

 +7        IF Y=""

               SET Y=$SELECT($GET(SDSELDF)]"":SDSELDF,1:"Return")

               GOTO ASKQ

 +8        WRITE !!?5,DIR("?"),".",!

           GOTO REASK

ASKQ       QUIT $GET(Y)