- PRCPCRU1 ;WISC/RFJ-cc & ik report utilities: select ;01 Sep 93
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- CASECART ; select a group of case carts
- ; if all carts are selected, return allcarts=1
- ; selected case carts are returned in tmp($j,"prcpcarts",itemda)
- N %,ITEMDA
- K ALLCARTS,^TMP($J,"PRCPCARTS")
- W !!,"To select ALL case carts, press RETURN."
- F S ITEMDA=$$SELECT^PRCPCED0("C",0,0) Q:'ITEMDA S ^TMP($J,"PRCPCARTS",ITEMDA)=""
- I ITEMDA["^" K ^TMP($J,"PRCPCARTS") Q
- 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
- I '$O(^TMP($J,"PRCPCARTS",0)),'$D(ALLCARTS) W !!,"NO CASE CARTS SELECTED!" Q
- Q
- ;
- ;
- INSTRKIT ; select a group of instrument kits
- ; if all kits are selected, return allkits=1
- ; selected instrument kits are returned in tmp($j,"prcpkits",itemda)
- N %,ITEMDA
- K ALLKITS,^TMP($J,"PRCPKITS")
- W !!,"To select ALL instrument kits, press RETURN."
- F S ITEMDA=$$SELECT^PRCPCED0("K",0,0) Q:'ITEMDA S ^TMP($J,"PRCPKITS",ITEMDA)=""
- I ITEMDA["^" K ^TMP($J,"PRCPKITS") Q
- 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
- I '$O(^TMP($J,"PRCPKITS",0)),'$D(ALLKITS) W !!,"NO INSTRUMENT KITS SELECTED!" Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPCRU1 1498 printed Apr 23, 2025@18:27:45 Page 2
- PRCPCRU1 ;WISC/RFJ-cc & ik report utilities: select ;01 Sep 93
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- CASECART ; select a group of case carts
- +1 ; if all carts are selected, return allcarts=1
- +2 ; selected case carts are returned in tmp($j,"prcpcarts",itemda)
- +3 NEW %,ITEMDA
- +4 KILL ALLCARTS,^TMP($JOB,"PRCPCARTS")
- +5 WRITE !!,"To select ALL case carts, press RETURN."
- +6 FOR
- SET ITEMDA=$$SELECT^PRCPCED0("C",0,0)
- if 'ITEMDA
- QUIT
- SET ^TMP($JOB,"PRCPCARTS",ITEMDA)=""
- +7 IF ITEMDA["^"
- KILL ^TMP($JOB,"PRCPCARTS")
- QUIT
- +8 IF '$ORDER(^TMP($JOB,"PRCPCARTS",0))
- SET XP="Do you want to select ALL case carts"
- SET XH="Enter 'YES' to select ALL case carts, 'NO' or '^' to exit."
- WRITE !
- IF $$YN^PRCPUYN(1)=1
- SET ALLCARTS=1
- +9 IF '$ORDER(^TMP($JOB,"PRCPCARTS",0))
- IF '$DATA(ALLCARTS)
- WRITE !!,"NO CASE CARTS SELECTED!"
- QUIT
- +10 QUIT
- +11 ;
- +12 ;
- INSTRKIT ; select a group of instrument kits
- +1 ; if all kits are selected, return allkits=1
- +2 ; selected instrument kits are returned in tmp($j,"prcpkits",itemda)
- +3 NEW %,ITEMDA
- +4 KILL ALLKITS,^TMP($JOB,"PRCPKITS")
- +5 WRITE !!,"To select ALL instrument kits, press RETURN."
- +6 FOR
- SET ITEMDA=$$SELECT^PRCPCED0("K",0,0)
- if 'ITEMDA
- QUIT
- SET ^TMP($JOB,"PRCPKITS",ITEMDA)=""
- +7 IF ITEMDA["^"
- KILL ^TMP($JOB,"PRCPKITS")
- QUIT
- +8 IF '$ORDER(^TMP($JOB,"PRCPKITS",0))
- SET XP="Do you want to select ALL instrument kits"
- SET XH="Enter 'YES' to select ALL instrument kits, 'NO' or '^' to exit."
- WRITE !
- IF $$YN^PRCPUYN(1)=1
- SET ALLKITS=1
- +9 IF '$ORDER(^TMP($JOB,"PRCPKITS",0))
- IF '$DATA(ALLKITS)
- WRITE !!,"NO INSTRUMENT KITS SELECTED!"
- QUIT
- +10 QUIT
