| 1 | PRCPURS1 ;WISC/RFJ/VAC-select group category list ; 11/2/06 11:32am
|
---|
| 2 | ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
|
---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | ;
|
---|
| 7 | GROUPSEL(V1) ; select group categories
|
---|
| 8 | ; v1=inventory point da
|
---|
| 9 | N %,G,GROUP,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPLINE,PRCPINPT
|
---|
| 10 | K ^TMP($J,"PRCPURS1"),GROUPALL
|
---|
| 11 | S PRCPINPT=+V1,PRCPLINE="",$P(PRCPLINE,"-",78)=""
|
---|
| 12 | S %=$$ALLGRP I %=0 Q
|
---|
| 13 | I %=1 S GROUPALL=1
|
---|
| 14 | F D I $G(PRCPFLAG) Q
|
---|
| 15 | . W !!
|
---|
| 16 | . I $O(^TMP($J,"PRCPURS1","YES",0))!($G(GROUPALL)) D
|
---|
| 17 | . . W !?2,PRCPLINE,!?2,"| Currently selected group categories:",?78,"|"
|
---|
| 18 | . . I $G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
|
---|
| 19 | . . E D
|
---|
| 20 | . . . W !?2,"| "
|
---|
| 21 | . . . S G=0 F S G=$O(^TMP($J,"PRCPURS1","YES",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 ?78,"|",!?2,"| " W %," "
|
---|
| 22 | . . . W ?78,"|"
|
---|
| 23 | . . W !?2,"| You can DE-select one of the above group categories by reselecting it.",?78,"|"
|
---|
| 24 | . I $O(^TMP($J,"PRCPURS1","NO",0))!('$G(GROUPALL)) D
|
---|
| 25 | . . W !?2,PRCPLINE,!?2,"| Currently DE-selected group categories:",?78,"|"
|
---|
| 26 | . . I '$G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
|
---|
| 27 | . . E D
|
---|
| 28 | . . . W !?2,"| "
|
---|
| 29 | . . . S G=0 F S G=$O(^TMP($J,"PRCPURS1","NO",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 ?78,"|",!?2,"| " W %," "
|
---|
| 30 | . . . W ?78,"|"
|
---|
| 31 | . . W !?2,"| You can RE-select one of the above group categories by reselecting it.",?78,"|"
|
---|
| 32 | . W !?2,PRCPLINE
|
---|
| 33 | . S GROUP=$$GROUP^PRCPEGRP(PRCPINPT,"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
|
---|
| 34 | . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
|
---|
| 35 | . I GROUP=0,'$O(^TMP($J,"PRCPURS1","YES",0)),'$G(GROUPALL) D Q
|
---|
| 36 | . . S %=$$ALLGRP I %=0 S (PRCPFLAG,PRCPEXIT)=1 Q
|
---|
| 37 | . . I %=1 S GROUPALL=1
|
---|
| 38 | . I GROUP=0 S PRCPFLAG=1 Q
|
---|
| 39 | . I $G(GROUPALL),'$D(^TMP($J,"PRCPURS1","NO",GROUP)) K ^TMP($J,"PRCPURS1","YES",GROUP) S ^TMP($J,"PRCPURS1","NO",GROUP)=GROUPNM W !?10,"*** DE-selected !" Q
|
---|
| 40 | . I $D(^TMP($J,"PRCPURS1","YES",GROUP)) K ^TMP($J,"PRCPURS1","YES",GROUP) S ^TMP($J,"PRCPURS1","NO",GROUP)=GROUPNM W !?10,"*** DE-selected !" Q
|
---|
| 41 | . I $D(^TMP($J,"PRCPURS1","NO",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** RE-selected !" Q
|
---|
| 42 | . S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** selected !"
|
---|
| 43 | I $G(PRCPEXIT) K ^TMP($J,"PRCPURS1"),GROUPALL Q
|
---|
| 44 | I $G(GROUPALL) K ^TMP($J,"PRCPURS1","YES")
|
---|
| 45 | Q
|
---|
| 46 | ;
|
---|
| 47 | ;
|
---|
| 48 | ALLGRP() ; select all group categories
|
---|
| 49 | ; returns 1 for yes, 2 for no, 0 for ^
|
---|
| 50 | S XP="Do you want to select ALL group categories",XH="Enter 'YES' to select ALL groups, 'NO' to not select all groups."
|
---|
| 51 | W !
|
---|
| 52 | Q $$YN^PRCPUYN(1)
|
---|
| 53 | ZEROQTY(Y) ;**98** Select zero quantity items to print or not or only
|
---|
| 54 | ;DIRUT - "^" entered, exit from this option and return to menu
|
---|
| 55 | ;Y - User selection, passed to calling routine for further process:
|
---|
| 56 | ; If Y=1, Include Zero Quantity Items
|
---|
| 57 | ; If Y=2, Do not include Zero Quantity Items
|
---|
| 58 | ; If Y=3, Include ONLY Zero Quantity Items
|
---|
| 59 | N X
|
---|
| 60 | W !
|
---|
| 61 | S X(1)="Select a number to display zero quantities or not "
|
---|
| 62 | D DISPLAY^PRCPUX2(3,42,.X)
|
---|
| 63 | K DIR
|
---|
| 64 | S DIR(0)="S^1: Include Zero Quantity items;2: Do not include Zero Quantity items;3: Print Only Zero Quantity items"
|
---|
| 65 | S DIR("A")="Select"
|
---|
| 66 | D ^DIR
|
---|
| 67 | K DIR
|
---|
| 68 | Q:$D(DIRUT) 0
|
---|
| 69 | Q Y
|
---|
| 70 | ;
|
---|