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