PRCPAGP0 ;WISC/RFJ-autogenerate primary or warehouse order ;11 Dec 92
;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
I "PW"'[PRCP("DPTYPE") W !!,"THIS OPTION CAN ONLY BE USED BY A PRIMARY OR WHSE INVENTORY POINT." Q
N %,G,GROUP,GROUPALL,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPREPN,VENDALL,WHSE,X,Y
S WHSE=+$O(^PRC(440,"AC","S",0)) I 'WHSE W !!,"WAREHOUSE VENDOR HAS NOT BEEN CREATED IN VENDOR FILE." Q
;
; get repetitive item list number
S %="========== PART 1: REPETITIVE ITEM LIST NUMBER ==========" W !!?(80-$L(%)\2),%
S PRCPREPN=$$GETRIL^PRCPAGPR I PRCPREPN="" Q
;
; select group categories
S %="========== PART 2A: SELECTION OF GROUP CATEGORIES ==========" W !!?(80-$L(%)\2),%
W !!,"Selected group categories and vendors will be used to auto-generate the order."
K ^TMP($J,"PRCPAG") D ALLGRP I $G(PRCPFLAG) Q
F D I $G(PRCPFLAG) Q
. I $O(^TMP($J,"PRCPAG","GY",0))!($G(GROUPALL)) D
. . W !!," Currently selected group categories:",!," "
. . I $G(GROUPALL) W "<< ALL GROUP CATEGORIES >>"
. . E S G=0 F S G=$O(^TMP($J,"PRCPAG","GY",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
. . W !," You can DE-select one of the above group categories by reselecting it."
. I $O(^TMP($J,"PRCPAG","GN",0)) D
. . W !!," Currently DE-selected group categories:",!," "
. . S G=0 F S G=$O(^TMP($J,"PRCPAG","GN",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
. . W !," You can RE-select one of the above group categories by reselecting it."
. W !!,"Select the name of the group category created for this primary, '^' to exit."
. S GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
. S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
. I GROUP=0,'$O(^TMP($J,"PRCPAG","GY",0)),'$G(GROUPALL) D ALLGRP S:$G(PRCPFLAG) PRCPEXIT=1 Q
. I GROUP=0 S PRCPFLAG=1 Q
. I $G(GROUPALL),'$D(^TMP($J,"PRCPAG","GN",GROUP)) K ^TMP($J,"PRCPAG","GY",GROUP) S ^TMP($J,"PRCPAG","GN",GROUP)=GROUPNM W !?10,"DE-selected !" Q
. I $D(^TMP($J,"PRCPAG","GY",GROUP)) K ^TMP($J,"PRCPAG","GY",GROUP) S ^TMP($J,"PRCPAG","GN",GROUP)=GROUPNM W !?10,"DE-selected !" Q
. I $D(^TMP($J,"PRCPAG","GN",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPAG","GY",GROUP)=GROUPNM W !?10,"RE-selected !" Q
. S ^TMP($J,"PRCPAG","GY",GROUP)=GROUPNM W !?10,"selected !"
I $G(PRCPEXIT) D Q Q
I $G(GROUPALL) K ^TMP($J,"PRCPAG","GY")
I '$G(GROUPALL),'$O(^TMP($J,"PRCPAG","GY",0)) W !!,"NO GROUP CATEGORIES SELECTED." D Q Q
;
; select vendors
S %="========== PART 2B: SELECTION OF VENDORS ==========" W !!?(80-$L(%)\2),%
S VENDALL=1
I $G(GROUPALL),'$O(^TMP($J,"PRCPAG","GN",0)) D GETVEND^PRCPAGPV I $G(PRCPEXIT) D Q Q
;
; start running autogen
I '$G(VENDALL),'$O(^TMP($J,"PRCPAG","VY",0)) W !!,"NO VENDORS SELECTED." D Q Q
I $G(VENDALL),'$O(^TMP($J,"PRCPAG","VN",0)) W !!,"<<< NOTE: Auto-generating for ALL vendors."
S %="========== PART 3: START AUTO-GENERATION ==========" W !!?(80-$L(%)\2),%
S XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION",XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
W !! I $$YN^PRCPUYN(1)=1 D START^PRCPAGP1
Q K ^TMP($J,"PRCPAG") Q
;
;
ALLGRP ; select all group categories
K GROUPALL,PRCPFLAG
S XP="Do you want to select ALL group categories",XH="Enter 'YES' to auto-generate for ALL inventory items selectable by vendor,",XH(1)="enter 'NO' to auto-generate selectable group category items not selectable by"
S XH(2)="vendor, or enter '^' to exit."
W ! S %=$$YN^PRCPUYN(1)
I %=2 Q
I %=1 S GROUPALL=1 Q
S PRCPFLAG=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGP0 3779 printed Sep 23, 2025@19:48:36 Page 2
PRCPAGP0 ;WISC/RFJ-autogenerate primary or warehouse order ;11 Dec 92
+1 ;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 IF "PW"'[PRCP("DPTYPE")
WRITE !!,"THIS OPTION CAN ONLY BE USED BY A PRIMARY OR WHSE INVENTORY POINT."
QUIT
+5 NEW %,G,GROUP,GROUPALL,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPREPN,VENDALL,WHSE,X,Y
+6 SET WHSE=+$ORDER(^PRC(440,"AC","S",0))
IF 'WHSE
WRITE !!,"WAREHOUSE VENDOR HAS NOT BEEN CREATED IN VENDOR FILE."
QUIT
+7 ;
+8 ; get repetitive item list number
+9 SET %="========== PART 1: REPETITIVE ITEM LIST NUMBER =========="
WRITE !!?(80-$LENGTH(%)\2),%
+10 SET PRCPREPN=$$GETRIL^PRCPAGPR
IF PRCPREPN=""
QUIT
+11 ;
+12 ; select group categories
+13 SET %="========== PART 2A: SELECTION OF GROUP CATEGORIES =========="
WRITE !!?(80-$LENGTH(%)\2),%
+14 WRITE !!,"Selected group categories and vendors will be used to auto-generate the order."
+15 KILL ^TMP($JOB,"PRCPAG")
DO ALLGRP
IF $GET(PRCPFLAG)
QUIT
+16 FOR
Begin DoDot:1
+17 IF $ORDER(^TMP($JOB,"PRCPAG","GY",0))!($GET(GROUPALL))
Begin DoDot:2
+18 WRITE !!," Currently selected group categories:",!," "
+19 IF $GET(GROUPALL)
WRITE "<< ALL GROUP CATEGORIES >>"
+20 IF '$TEST
SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPAG","GY",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !," "
WRITE %," "
+21 WRITE !," You can DE-select one of the above group categories by reselecting it."
End DoDot:2
+22 IF $ORDER(^TMP($JOB,"PRCPAG","GN",0))
Begin DoDot:2
+23 WRITE !!," Currently DE-selected group categories:",!," "
+24 SET G=0
FOR
SET G=$ORDER(^TMP($JOB,"PRCPAG","GN",G))
if 'G
QUIT
SET %=$EXTRACT(^(G),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !," "
WRITE %," "
+25 WRITE !," You can RE-select one of the above group categories by reselecting it."
End DoDot:2
+26 WRITE !!,"Select the name of the group category created for this primary, '^' to exit."
+27 SET GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"")
IF GROUP<0
SET (PRCPFLAG,PRCPEXIT)=1
QUIT
+28 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
+29 IF GROUP=0
IF '$ORDER(^TMP($JOB,"PRCPAG","GY",0))
IF '$GET(GROUPALL)
DO ALLGRP
if $GET(PRCPFLAG)
SET PRCPEXIT=1
QUIT
+30 IF GROUP=0
SET PRCPFLAG=1
QUIT
+31 IF $GET(GROUPALL)
IF '$DATA(^TMP($JOB,"PRCPAG","GN",GROUP))
KILL ^TMP($JOB,"PRCPAG","GY",GROUP)
SET ^TMP($JOB,"PRCPAG","GN",GROUP)=GROUPNM
WRITE !?10,"DE-selected !"
QUIT
+32 IF $DATA(^TMP($JOB,"PRCPAG","GY",GROUP))
KILL ^TMP($JOB,"PRCPAG","GY",GROUP)
SET ^TMP($JOB,"PRCPAG","GN",GROUP)=GROUPNM
WRITE !?10,"DE-selected !"
QUIT
+33 IF $DATA(^TMP($JOB,"PRCPAG","GN",GROUP))
KILL ^(GROUP)
SET ^TMP($JOB,"PRCPAG","GY",GROUP)=GROUPNM
WRITE !?10,"RE-selected !"
QUIT
+34 SET ^TMP($JOB,"PRCPAG","GY",GROUP)=GROUPNM
WRITE !?10,"selected !"
End DoDot:1
IF $GET(PRCPFLAG)
QUIT
+35 IF $GET(PRCPEXIT)
DO Q
QUIT
+36 IF $GET(GROUPALL)
KILL ^TMP($JOB,"PRCPAG","GY")
+37 IF '$GET(GROUPALL)
IF '$ORDER(^TMP($JOB,"PRCPAG","GY",0))
WRITE !!,"NO GROUP CATEGORIES SELECTED."
DO Q
QUIT
+38 ;
+39 ; select vendors
+40 SET %="========== PART 2B: SELECTION OF VENDORS =========="
WRITE !!?(80-$LENGTH(%)\2),%
+41 SET VENDALL=1
+42 IF $GET(GROUPALL)
IF '$ORDER(^TMP($JOB,"PRCPAG","GN",0))
DO GETVEND^PRCPAGPV
IF $GET(PRCPEXIT)
DO Q
QUIT
+43 ;
+44 ; start running autogen
+45 IF '$GET(VENDALL)
IF '$ORDER(^TMP($JOB,"PRCPAG","VY",0))
WRITE !!,"NO VENDORS SELECTED."
DO Q
QUIT
+46 IF $GET(VENDALL)
IF '$ORDER(^TMP($JOB,"PRCPAG","VN",0))
WRITE !!,"<<< NOTE: Auto-generating for ALL vendors."
+47 SET %="========== PART 3: START AUTO-GENERATION =========="
WRITE !!?(80-$LENGTH(%)\2),%
+48 SET XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION"
SET XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
+49 WRITE !!
IF $$YN^PRCPUYN(1)=1
DO START^PRCPAGP1
Q KILL ^TMP($JOB,"PRCPAG")
QUIT
+1 ;
+2 ;
ALLGRP ; select all group categories
+1 KILL GROUPALL,PRCPFLAG
+2 SET XP="Do you want to select ALL group categories"
SET XH="Enter 'YES' to auto-generate for ALL inventory items selectable by vendor,"
SET XH(1)="enter 'NO' to auto-generate selectable group category items not selectable by"
+3 SET XH(2)="vendor, or enter '^' to exit."
+4 WRITE !
SET %=$$YN^PRCPUYN(1)
+5 IF %=2
QUIT
+6 IF %=1
SET GROUPALL=1
QUIT
+7 SET PRCPFLAG=1
QUIT
