source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGRO.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1PRCPAGRO ;WISC/RFJ,DXH/VAC - autogenerate print suggested distribution order ; 2/19/07 12:46pm
2 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;*98 Modified to accommodate On-Demand items.
5 Q
6 ;
7 ;
8ORDER ; print order to create
9 ; for ^tmp($j,"prcpag","ok",vendorname,vendorda,groupname,
10 ; xxx,itemda) where xxx equals whse:nsn; prim or seco:descr
11 N %,%H,%I,D,DESCNSN,GNM,ITEMDA,NOW,ODITEM,ORDER,PAGE,SCREEN,TOTCOST,VDA,VNM,X,Y
12 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO
13 S VNM="" F S VNM=$O(^TMP($J,"PRCPAG","OK",VNM)) Q:VNM=""!($G(PRCPFLAG)) S VDA=0 F S VDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA)) Q:'VDA!($G(PRCPFLAG)) D
14 . I PAGE>1 D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG)
15 . S TOTCOST=0,ORDER=$G(^TMP($J,"PRCPAG","VO",VDA)) S:ORDER="" ORDER="<< UNABLE TO CREATE ORDER >>" D H
16 . S GNM="" F S GNM=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM)) Q:GNM=""!($G(PRCPFLAG)) D
17 .. I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
18 .. W !!?12,"GROUP CATEGORY: ",$S(GNM=" ":"<< NOT SPECIFIED >>",1:GNM)
19 .. S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN)) Q:DESCNSN=""!($G(PRCPFLAG)) D
20 ... S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S D=^(ITEMDA) D
21 .... S %=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
22 .... S ODITEM=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
23 .... I PRCP("DPTYPE")="W" D
24 ..... W !!,ITEMDA,?7 W:PRCP("DPTYPE")'="W" $E(%,1,35) W:PRCP("DPTYPE")="W" $E(%,1,20),?31,$$NSN^PRCPUX1(ITEMDA) W ?50,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),9),$J($P(D,"^",12),9),$J($P(D,"^",15),6),$J($P(D,"^",16),6)
25 .... I PRCP("DPTYPE")'="W" D
26 ..... W !!,ITEMDA
27 ..... I ODITEM="Y" W ?8,"D "
28 ..... I ODITEM'="Y" W ?8," "
29 ..... W:PRCP("DPTYPE")'="W" $E(%,1,32) W:PRCP("DPTYPE")="W" $E(%,1,17)
30 .... W ?31,$$NSN^PRCPUX1(ITEMDA) W ?50,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),9),$J($P(D,"^",12),9),$J($P(D,"^",15),6),$J($P(D,"^",16),6)
31 .... W !,$J("ONHAND",8),$J("+DUEIN",8),$J("-DUEOUT",8),$J("=AVAIL",8),$J("STAND",7),$J("OPTN",8),$J("LEVEL",8),$J("CONV",7),$J("ORDER",8),$J("UNIT$",10)
32 .... W !,$J(+$P(D,"^"),8),$J(+$P(D,"^",2),8),$J(+$P(D,"^",3),8),$J(+$P(D,"^",4),8),$J(+$P(D,"^",5),7),$S($P(D,"^",7)="STA":"*",1:" "),$J(+$P(D,"^",6),7),$S($P(D,"^",7)="OPT":"*",1:" ")
33 .... W $J(+$P(D,"^",8),7),$S($P(D,"^",9)="*":"*",1:" "),$J(+$P(D,"^",10),6),$J(+$P(D,"^",11),8),$J(+$P(D,"^",14),10,3)
34 .... S TOTCOST=TOTCOST+$J($P(D,"^",11)*$P(D,"^",14),0,2)
35 .... I $Y>(IOSL-9) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H W !!?12,"GROUP CATEGORY: ",$S(GNM=" ":"<< NOT SPECIFIED >>",1:GNM)
36 . I $G(PRCPFLAG) Q
37 . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H
38 . W !!,"TOTAL COST OF ORDER: ",TOTCOST
39 I $G(PRCPFLAG) Q
40 D END^PRCPUREP
41 Q
42 ;
43 ;
44H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
45 W $C(13),"AUTO-GEN: SUGGESTED ORDERS FOR ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
46 W !?5,"ORDERING FROM ",$S(PRCP("DPTYPE")="S":"PRIMARY INVENTORY POINT",1:"VENDOR"),": ",VNM
47 W !?5,$S(PRCP("DPTYPE")="S":"DISTRIBUTION ORDER",1:"REPETITIVE ITEM LIST")," NUMBER: ",ORDER
48 W !?50,$J($S(PRCP("DPTYPE")="S":"SECONDARY",PRCP("DPTYPE")="P":"PRIMARY",1:"WHSE"),9),$J($S(PRCP("DPTYPE")="S":"PRIMARY",1:"VENDOR"),9),$J("ISSUE",6),$J("ISSUE",6)
49 W !,"IM#"
50 I PRCP("DPTYPE")="W" D
51 . W ?7,"DESCRIPTION"
52 I PRCP("DPTYPE")'="W" D
53 . W ?8,"OD",?11,"DESCRIPTION"
54 W:PRCP("DPTYPE") ?31,"NSN" W ?50,$J("UNIT/ISS",9),$J("UNIT/ISS",9),$J("MINIM",6),$J("MULT",6)
55 S %="",$P(%,"-",81)="" W !,%
56 Q
Note: See TracBrowser for help on using the repository browser.