- 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 Feb 18, 2025@23:38:54 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