source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGU2.m@ 1769

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PRCPAGU2 ;WISC/RFJ-autogenerate find quantity ;11 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 ;
7QTYORD ; continue with auto-generation; get quantity to order
8 ; available=onhand+duein-dueout
9 ; if available<standard or available<optional, order it
10 ; up to normal stock level or temp stock level
11 N DUEIN,DUEOUT
12 S DUEIN=$$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),DUEOUT=$$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA)
13 S QTYAVAIL=$P(ITEMDATA,"^",7)+DUEIN-DUEOUT
14 S LEVEL=$P(ITEMDATA,"^",9),TEMPLVL="" I $P(ITEMDATA,"^",23) S LEVEL=$P(ITEMDATA,"^",23),TEMPLVL="*"
15 S QTY=0,TYPE=""
16 ; its less than optional reorder point
17 I QTYAVAIL'>$P(ITEMDATA,"^",4) S QTY=LEVEL-QTYAVAIL,TYPE="OPT"
18 ; its less than stand reorder point, but optional is entered
19 I QTYAVAIL'>$P(ITEMDATA,"^",10),QTY S TYPE="STA"
20 ; its less than stand reorder point, no optional
21 I QTYAVAIL'>$P(ITEMDATA,"^",10),'QTY S QTY=LEVEL-QTYAVAIL,TYPE="STA"
22 I 'QTY S ORDER="NOT" D SET Q
23 S QTY=QTY/CONV I $P(QTY,".",2)>0 S QTY=$P(QTY,".")+1
24 ; bring quantity up to minum issue qty and issue multiple
25 I QTY<MINISS S QTY=MINISS
26 I ISSMULT>1 S %=QTY#ISSMULT I % S QTY=QTY+ISSMULT-%
27 S TOTITEMS=TOTITEMS+1,ORDER="OK"
28SET ; set temp global with orders ORDER = "OK" or "NOT" ordered
29 S %="^"_QTYAVAIL_"^"_$P(ITEMDATA,"^",10)_"^"_$P(ITEMDATA,"^",4)_"^"_TYPE_"^"_LEVEL_"^"_TEMPLVL_"^"_CONV_"^"_QTY_"^"_UNITI_"^"_UNITR_"^"_COST_"^"_MINISS_"^"_ISSMULT
30 S ^TMP($J,"PRCPAG",ORDER,$E(VENDORNM,1,10),VENDOR,GROUPNM,DESCNSN,ITEMDA)=$P(ITEMDATA,"^",7)_"^"_DUEIN_"^"_DUEOUT_%
31 I ORDER="NOT" Q
32 S ^TMP($J,"PRCPAG","V+",VENDOR,TYPE)="" Q
Note: See TracBrowser for help on using the repository browser.