source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPBAL2.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRCPBAL2 ;WISC/RFJ-autogenerate orders for secondaries uploaded ;04 Dec 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7AUTOGEN ; autogenerate secondaries
8 K ^TMP($J,"PRCPBALMAG"),^TMP($J,"PRCPBAL3")
9 S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT I $P($G(^PRCP(445,INVPT,0)),"^",3)="S",$P($G(^PRCP(445,INVPT,0)),"^",2)="Y" Q
10 ; no sceondaries uploaded
11 I 'INVPT Q
12 W !!,"AUTOGENERATING UPLOADED SECONDARIES..."
13 I '$G(PRCP("I")) N PRCP S PRCP("DPTYPE")="P" K X S X(1)="Select the PRIMARY inventory point which will be used as the distribution point for the secondaries." W ! D DISPLAY^PRCPUX2(1,40,.X),^PRCPUSEL Q:'$G(PRCP("I"))
14 S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMU",INVPT)) Q:'INVPT I $P($G(^PRCP(445,INVPT,0)),"^",3)="S",$P($G(^PRCP(445,INVPT,0)),"^",2)="Y",$D(^PRCP(445,PRCP("I"),2,INVPT)) S ^TMP($J,"PRCPBALMAG",INVPT)=""
15 I '$O(^TMP($J,"PRCPBALMAG",0)) Q
16 K X S X(1)="The following perpetual secondaries have been uploaded and are distribution points for "_$$INVNAME^PRCPUX1(PRCP("I"))_":" W ! D DISPLAY^PRCPUX2(5,75,.X)
17 S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMAG",INVPT)) Q:'INVPT W !?10,$$INVNAME^PRCPUX1(INVPT)
18 S XP="Do you want to start autogenerating distribution orders now",XH="Enter YES to start autogenerating orders for the secondaries, NO or ^ to exit."
19 I $$YN^PRCPUYN(2)'=1 Q
20 ;
21 N PRCPFBAR,PRCPIO
22 ;
23 K X S X(1)="The normal reports showing the errors during autogeneration, items with vendors not selected, items not ordered, etc. will not be printed. You have the option to print the report showing the items ordered."
24 W ! D DISPLAY^PRCPUX2(5,75,.X)
25 S XP="Do you want to print the report showing the items ordered",XH="Enter YES to print the report showing the items ordered during autogeneration,",XH(1)="NO to skip printing the report, or ^ to exit."
26 S %=$$YN^PRCPUYN(2) I %<1 Q
27 I %=1 D Q:'$D(PRCPIO)
28 . K X S X(1)="Select the DEVICE for printing the ordered items. This report will be automatically queued to print for you." W ! D DISPLAY^PRCPUX2(5,75,.X)
29 . F S %ZIS="NQ" D ^%ZIS Q:POP!(IO'=IO(0)) W !,"YOU CANNOT SELECT YOUR CURRENT DEVICE."
30 . I POP Q
31 . S PRCPIO=ION
32 ;
33 S INVPT=0 F S INVPT=$O(^TMP($J,"PRCPBALMAG",INVPT)) Q:'INVPT D
34 . ; set prcpfbar flag to the primary to fill the order. This
35 . ; flag will be used to stop the printing of all autogeneration
36 . ; reports
37 . S PRCPFBAR=PRCP("I")
38 . N PRCP
39 . D PARAM^PRCPUSEL(INVPT)
40 . W !!,"**** AUTOGENERATING FROM INVENTORY POINT: ",PRCP("IN")," ****"
41 . K ^TMP($J,"PRCPAG")
42 . ; selected vendor
43 . S ^TMP($J,"PRCPAG","V",PRCPFBAR)=""
44 . D START^PRCPAGS1
45 . I $D(PRCPIO),$O(^TMP($J,"PRCPAG","OK",""))'="" D
46 . . W !,"<<< Printing Items Ordered Report"
47 . . S ZTDESC="Bar Code Upload Autogenerate",ZTRTN="ORDER^PRCPAGRO",ZTIO=PRCPIO,ZTDTH=$H,ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,")="",ZTSAVE("ZTREQ")="@"
48 . . D ^%ZTLOAD K ZTSK
49 . K ^TMP($J,"PRCPAG")
50 ;
51 ; if orders in ^tmp($j,"prcpbal3",orderda), ask to release
52 I '$O(^TMP($J,"PRCPBAL3",0)) Q
53 K X S X(1)=" F I N I S H E D A U T O G E N E R A T I O N " W ! D DISPLAY^PRCPUX2(1,79,.X)
54 ; show orders created
55 K X S X(1)="The following is the list of the orders created showing the order number and secondary inventory point generating the order." W ! D DISPLAY^PRCPUX2(5,75,.X)
56 S %=0 F S %=$O(^TMP($J,"PRCPBAL3",%)) Q:'% S X=$G(^PRCP(445.3,%,0)) I X'="" W !?5,"order number ",$J($P(X,"^"),5)," from secondary ",$$INVNAME^PRCPUX1($P(X,"^",3))
57 K X S X(1)="You have the option to release all the orders which were just created by this barcode upload." W !! D DISPLAY^PRCPUX2(2,40,.X)
58 S XP="Do you want to release all the orders created during the barcode upload",XH="Enter YES to release all the orders created, NO or ^ to exit."
59 I $$YN^PRCPUYN(1)'=1 Q
60 D RELEASE^PRCPBAL3
61 ;
62 ; if orders in ^tmp($j,"prcpbal3",orderda), ask to print pick tickets
63 I '$O(^TMP($J,"PRCPBAL3",0)) Q
64 K X S X(1)="You have the option to print the picking tickets for all the orders just released." W !! D DISPLAY^PRCPUX2(2,40,.X)
65 S XP="Do you want to print the picking ticket for the orders just released",XH="Enter YES to print the picking ticket for the orders just released, NO or ^ to exit."
66 I $$YN^PRCPUYN(1)'=1 Q
67 D PICKTICK^PRCPBAL3
68 Q
Note: See TracBrowser for help on using the repository browser.