source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWBO1.m@ 1581

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1PSGWBO1 ;BHAM ISC/CML-Enter/Edit Actual Dispensed/Backorder Values - CONTINUED ; 09/27/89 13:57
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3 ;
4CHKQTY ;Check Qty. Dispensed for reasonable amount (2 X Stock Level)
5 K QTYFLG Q:'$D(^PSI(58.1,PSGWDA,1,PSGDDA,0)) S STKLEV=$P(^(0),"^",2) I 'STKLEV K STKLEV Q
6 I X'>(2*STKLEV) K STKLEV Q
7 W *7,!!,"This quantity seems too high! The normal Stock Level for this item is ",STKLEV
8ASK W !?5,"Are you sure of this amount " S %=2 D YN^DICN I %=1 K STKLEV Q
9 I %=0 W " Enter 'YES' or 'NO'" G ASK
10 S QTYFLG=1 K STKLEV Q
11GETVAL S DIC("W")="W $P(^(0),""^"",8)"
12 I $L(X)>1 S DIC(0)="QEM",X=$E(X,2,$L(X))
13 E S DIC(0)="QEAM"
14 S DIC="^PSI(58.1,"_PSGWDA_",1," D ^DIC S DA=+Y K DIC Q:Y<0 D ALIGN Q
15ALIGN ;Align on this item
16 Q:'$D(^PSI(58.1,PSGWDA,1,+Y,0)) S K=^(0) D LOC S TYP=""
17TYP S TYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,TPSG1,TPSG2,TPSG3,TYP)) I TYP="" W *7,"??",!!,"You may only 'up-arrow' to Items from this AOU",!,"that are included in this Inventory Date/Time!!",!!,"ITEM: ",TEMPDR S DA=-1,PSGDR=TEMPDR Q
18 S PSG1=TPSG1,PSG2=TPSG2,PSG3=TPSG3
19 I $D(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,TYP,PSGDR)) S PSGTYP=TYP,PSGDR=$E(PSGDR,1,$L(PSGDR)-1)_$E(" ",$E(PSGDR,$L(PSGDR))'=" ") Q
20 E G TYP
21LOC ;Build item address
22 S K1=$P(K,"^",8) F I=1:1:3 S @("TPSG"_I)=$S($P(K1,",",I)]"":$P(K1,",",I),1:" ")
23 S PSGDR=$S($D(^PSDRUG(+K,0))#2:$P(^(0),"^",1),1:+K)
24 Q
Note: See TracBrowser for help on using the repository browser.