| [613] | 1 | PRCPCRU1 ;WISC/RFJ-cc & ik report utilities: select ;01 Sep 93
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | CASECART ; select a group of case carts
|
|---|
| 8 | ; if all carts are selected, return allcarts=1
|
|---|
| 9 | ; selected case carts are returned in tmp($j,"prcpcarts",itemda)
|
|---|
| 10 | N %,ITEMDA
|
|---|
| 11 | K ALLCARTS,^TMP($J,"PRCPCARTS")
|
|---|
| 12 | W !!,"To select ALL case carts, press RETURN."
|
|---|
| 13 | F S ITEMDA=$$SELECT^PRCPCED0("C",0,0) Q:'ITEMDA S ^TMP($J,"PRCPCARTS",ITEMDA)=""
|
|---|
| 14 | I ITEMDA["^" K ^TMP($J,"PRCPCARTS") Q
|
|---|
| 15 | I '$O(^TMP($J,"PRCPCARTS",0)) S XP="Do you want to select ALL case carts",XH="Enter 'YES' to select ALL case carts, 'NO' or '^' to exit." W ! I $$YN^PRCPUYN(1)=1 S ALLCARTS=1
|
|---|
| 16 | I '$O(^TMP($J,"PRCPCARTS",0)),'$D(ALLCARTS) W !!,"NO CASE CARTS SELECTED!" Q
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | ;
|
|---|
| 20 | INSTRKIT ; select a group of instrument kits
|
|---|
| 21 | ; if all kits are selected, return allkits=1
|
|---|
| 22 | ; selected instrument kits are returned in tmp($j,"prcpkits",itemda)
|
|---|
| 23 | N %,ITEMDA
|
|---|
| 24 | K ALLKITS,^TMP($J,"PRCPKITS")
|
|---|
| 25 | W !!,"To select ALL instrument kits, press RETURN."
|
|---|
| 26 | F S ITEMDA=$$SELECT^PRCPCED0("K",0,0) Q:'ITEMDA S ^TMP($J,"PRCPKITS",ITEMDA)=""
|
|---|
| 27 | I ITEMDA["^" K ^TMP($J,"PRCPKITS") Q
|
|---|
| 28 | I '$O(^TMP($J,"PRCPKITS",0)) S XP="Do you want to select ALL instrument kits",XH="Enter 'YES' to select ALL instrument kits, 'NO' or '^' to exit." W ! I $$YN^PRCPUYN(1)=1 S ALLKITS=1
|
|---|
| 29 | I '$O(^TMP($J,"PRCPKITS",0)),'$D(ALLKITS) W !!,"NO INSTRUMENT KITS SELECTED!" Q
|
|---|
| 30 | Q
|
|---|
