- 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 Feb 18, 2025@23:42:41 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 ;