source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPURS1.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1PRCPURS1 ;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 ;
7GROUPSEL(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 ;
48ALLGRP() ; 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)
53ZEROQTY(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 ;
Note: See TracBrowser for help on using the repository browser.