Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPURS1

PRCPURS1.m

Go to the documentation of this file.
  1. PRCPURS1 ;WISC/RFJ/VAC-select group category list ; 11/2/06 11:32am
  1. ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. GROUPSEL(V1) ; select group categories
  1. ; v1=inventory point da
  1. N %,G,GROUP,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPLINE,PRCPINPT
  1. K ^TMP($J,"PRCPURS1"),GROUPALL
  1. S PRCPINPT=+V1,PRCPLINE="",$P(PRCPLINE,"-",78)=""
  1. S %=$$ALLGRP I %=0 Q
  1. I %=1 S GROUPALL=1
  1. F D I $G(PRCPFLAG) Q
  1. . W !!
  1. . I $O(^TMP($J,"PRCPURS1","YES",0))!($G(GROUPALL)) D
  1. . . W !?2,PRCPLINE,!?2,"| Currently selected group categories:",?78,"|"
  1. . . I $G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
  1. . . E D
  1. . . . W !?2,"| "
  1. . . . 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 %," "
  1. . . . W ?78,"|"
  1. . . W !?2,"| You can DE-select one of the above group categories by reselecting it.",?78,"|"
  1. . I $O(^TMP($J,"PRCPURS1","NO",0))!('$G(GROUPALL)) D
  1. . . W !?2,PRCPLINE,!?2,"| Currently DE-selected group categories:",?78,"|"
  1. . . I '$G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
  1. . . E D
  1. . . . W !?2,"| "
  1. . . . 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 %," "
  1. . . . W ?78,"|"
  1. . . W !?2,"| You can RE-select one of the above group categories by reselecting it.",?78,"|"
  1. . W !?2,PRCPLINE
  1. . S GROUP=$$GROUP^PRCPEGRP(PRCPINPT,"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
  1. . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
  1. . I GROUP=0,'$O(^TMP($J,"PRCPURS1","YES",0)),'$G(GROUPALL) D Q
  1. . . S %=$$ALLGRP I %=0 S (PRCPFLAG,PRCPEXIT)=1 Q
  1. . . I %=1 S GROUPALL=1
  1. . I GROUP=0 S PRCPFLAG=1 Q
  1. . 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
  1. . 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
  1. . I $D(^TMP($J,"PRCPURS1","NO",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** RE-selected !" Q
  1. . S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** selected !"
  1. I $G(PRCPEXIT) K ^TMP($J,"PRCPURS1"),GROUPALL Q
  1. I $G(GROUPALL) K ^TMP($J,"PRCPURS1","YES")
  1. Q
  1. ;
  1. ;
  1. ALLGRP() ; select all group categories
  1. ; returns 1 for yes, 2 for no, 0 for ^
  1. S XP="Do you want to select ALL group categories",XH="Enter 'YES' to select ALL groups, 'NO' to not select all groups."
  1. W !
  1. Q $$YN^PRCPUYN(1)
  1. ZEROQTY(Y) ;**98** Select zero quantity items to print or not or only
  1. ;DIRUT - "^" entered, exit from this option and return to menu
  1. ;Y - User selection, passed to calling routine for further process:
  1. ; If Y=1, Include Zero Quantity Items
  1. ; If Y=2, Do not include Zero Quantity Items
  1. ; If Y=3, Include ONLY Zero Quantity Items
  1. N X
  1. W !
  1. S X(1)="Select a number to display zero quantities or not "
  1. D DISPLAY^PRCPUX2(3,42,.X)
  1. K DIR
  1. S DIR(0)="S^1: Include Zero Quantity items;2: Do not include Zero Quantity items;3: Print Only Zero Quantity items"
  1. S DIR("A")="Select"
  1. D ^DIR
  1. K DIR
  1. Q:$D(DIRUT) 0
  1. Q Y
  1. ;