PRCPURS1 ;WISC/RFJ/VAC-select group category list ; 11/2/06 11:32am
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
GROUPSEL(V1) ; select group categories
; v1=inventory point da
N %,G,GROUP,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPLINE,PRCPINPT
K ^TMP($J,"PRCPURS1"),GROUPALL
S PRCPINPT=+V1,PRCPLINE="",$P(PRCPLINE,"-",78)=""
S %=$$ALLGRP I %=0 Q
I %=1 S GROUPALL=1
F D I $G(PRCPFLAG) Q
. W !!
. I $O(^TMP($J,"PRCPURS1","YES",0))!($G(GROUPALL)) D
. . W !?2,PRCPLINE,!?2,"| Currently selected group categories:",?78,"|"
. . I $G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
. . E D
. . . W !?2,"| "
. . . 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 %," "
. . . W ?78,"|"
. . W !?2,"| You can DE-select one of the above group categories by reselecting it.",?78,"|"
. I $O(^TMP($J,"PRCPURS1","NO",0))!('$G(GROUPALL)) D
. . W !?2,PRCPLINE,!?2,"| Currently DE-selected group categories:",?78,"|"
. . I '$G(GROUPALL) W !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
. . E D
. . . W !?2,"| "
. . . 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 %," "
. . . W ?78,"|"
. . W !?2,"| You can RE-select one of the above group categories by reselecting it.",?78,"|"
. W !?2,PRCPLINE
. S GROUP=$$GROUP^PRCPEGRP(PRCPINPT,"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
. S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
. I GROUP=0,'$O(^TMP($J,"PRCPURS1","YES",0)),'$G(GROUPALL) D Q
. . S %=$$ALLGRP I %=0 S (PRCPFLAG,PRCPEXIT)=1 Q
. . I %=1 S GROUPALL=1
. I GROUP=0 S PRCPFLAG=1 Q
. 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
. 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
. I $D(^TMP($J,"PRCPURS1","NO",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** RE-selected !" Q
. S ^TMP($J,"PRCPURS1","YES",GROUP)=GROUPNM W !?10,"*** selected !"
I $G(PRCPEXIT) K ^TMP($J,"PRCPURS1"),GROUPALL Q
I $G(GROUPALL) K ^TMP($J,"PRCPURS1","YES")
Q
;
;
ALLGRP() ; select all group categories
; returns 1 for yes, 2 for no, 0 for ^
S XP="Do you want to select ALL group categories",XH="Enter 'YES' to select ALL groups, 'NO' to not select all groups."
W !
Q $$YN^PRCPUYN(1)
ZEROQTY(Y) ;**98** Select zero quantity items to print or not or only
;DIRUT - "^" entered, exit from this option and return to menu
;Y - User selection, passed to calling routine for further process:
; If Y=1, Include Zero Quantity Items
; If Y=2, Do not include Zero Quantity Items
; If Y=3, Include ONLY Zero Quantity Items
N X
W !
S X(1)="Select a number to display zero quantities or not "
D DISPLAY^PRCPUX2(3,42,.X)
K DIR
S DIR(0)="S^1: Include Zero Quantity items;2: Do not include Zero Quantity items;3: Print Only Zero Quantity items"
S DIR("A")="Select"
D ^DIR
K DIR
Q:$D(DIRUT) 0
Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPURS1 3361 printed Sep 23, 2025@19:52:23 Page 2
PRCPURS1 ;WISC/RFJ/VAC-select group category list ; 11/2/06 11:32am
+1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
GROUPSEL(V1) ; select group categories
+1 ; v1=inventory point da
+2 NEW %,G,GROUP,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPLINE,PRCPINPT
+3 KILL ^TMP($JOB,"PRCPURS1"),GROUPALL
+4 SET PRCPINPT=+V1
SET PRCPLINE=""
SET $PIECE(PRCPLINE,"-",78)=""
+5 SET %=$$ALLGRP
IF %=0
QUIT
+6 IF %=1
SET GROUPALL=1
+7 FOR
Begin DoDot:1
+8 WRITE !!
+9 IF $ORDER(^TMP($JOB,"PRCPURS1","YES",0))!($GET(GROUPALL))
Begin DoDot:2
+10 WRITE !?2,PRCPLINE,!?2,"| Currently selected group categories:",?78,"|"
+11 IF $GET(GROUPALL)
WRITE !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
+12 IF '$TEST
Begin DoDot:3
+13 WRITE !?2,"| "
+14 SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPURS1","YES",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE ?78,"|",!?2,"| "
WRITE %," "
+15 WRITE ?78,"|"
End DoDot:3
+16 WRITE !?2,"| You can DE-select one of the above group categories by reselecting it.",?78,"|"
End DoDot:2
+17 IF $ORDER(^TMP($JOB,"PRCPURS1","NO",0))!('$GET(GROUPALL))
Begin DoDot:2
+18 WRITE !?2,PRCPLINE,!?2,"| Currently DE-selected group categories:",?78,"|"
+19 IF '$GET(GROUPALL)
WRITE !?2,"| << ALL GROUP CATEGORIES >>",?78,"|"
+20 IF '$TEST
Begin DoDot:3
+21 WRITE !?2,"| "
+22 SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPURS1","NO",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE ?78,"|",!?2,"| "
WRITE %," "
+23 WRITE ?78,"|"
End DoDot:3
+24 WRITE !?2,"| You can RE-select one of the above group categories by reselecting it.",?78,"|"
End DoDot:2
+25 WRITE !?2,PRCPLINE
+26 SET GROUP=$$GROUP^PRCPEGRP(PRCPINPT,"")
IF GROUP<0
SET (PRCPFLAG,PRCPEXIT)=1
QUIT
+27 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
+28 IF GROUP=0
IF '$ORDER(^TMP($JOB,"PRCPURS1","YES",0))
IF '$GET(GROUPALL)
Begin DoDot:2
+29 SET %=$$ALLGRP
IF %=0
SET (PRCPFLAG,PRCPEXIT)=1
QUIT
+30 IF %=1
SET GROUPALL=1
End DoDot:2
QUIT
+31 IF GROUP=0
SET PRCPFLAG=1
QUIT
+32 IF $GET(GROUPALL)
IF '$DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
KILL ^TMP($JOB,"PRCPURS1","YES",GROUP)
SET ^TMP($JOB,"PRCPURS1","NO",GROUP)=GROUPNM
WRITE !?10,"*** DE-selected !"
QUIT
+33 IF $DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))
KILL ^TMP($JOB,"PRCPURS1","YES",GROUP)
SET ^TMP($JOB,"PRCPURS1","NO",GROUP)=GROUPNM
WRITE !?10,"*** DE-selected !"
QUIT
+34 IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
KILL ^(GROUP)
SET ^TMP($JOB,"PRCPURS1","YES",GROUP)=GROUPNM
WRITE !?10,"*** RE-selected !"
QUIT
+35 SET ^TMP($JOB,"PRCPURS1","YES",GROUP)=GROUPNM
WRITE !?10,"*** selected !"
End DoDot:1
IF $GET(PRCPFLAG)
QUIT
+36 IF $GET(PRCPEXIT)
KILL ^TMP($JOB,"PRCPURS1"),GROUPALL
QUIT
+37 IF $GET(GROUPALL)
KILL ^TMP($JOB,"PRCPURS1","YES")
+38 QUIT
+39 ;
+40 ;
ALLGRP() ; select all group categories
+1 ; returns 1 for yes, 2 for no, 0 for ^
+2 SET XP="Do you want to select ALL group categories"
SET XH="Enter 'YES' to select ALL groups, 'NO' to not select all groups."
+3 WRITE !
+4 QUIT $$YN^PRCPUYN(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
+2 ;Y - User selection, passed to calling routine for further process:
+3 ; If Y=1, Include Zero Quantity Items
+4 ; If Y=2, Do not include Zero Quantity Items
+5 ; If Y=3, Include ONLY Zero Quantity Items
+6 NEW X
+7 WRITE !
+8 SET X(1)="Select a number to display zero quantities or not "
+9 DO DISPLAY^PRCPUX2(3,42,.X)
+10 KILL DIR
+11 SET DIR(0)="S^1: Include Zero Quantity items;2: Do not include Zero Quantity items;3: Print Only Zero Quantity items"
+12 SET DIR("A")="Select"
+13 DO ^DIR
+14 KILL DIR
+15 if $DATA(DIRUT)
QUIT 0
+16 QUIT Y
+17 ;
