- PSGWBO1 ;BHAM ISC/CML-Enter/Edit Actual Dispensed/Backorder Values - CONTINUED ; 09/27/89 13:57
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ;
- CHKQTY ;Check Qty. Dispensed for reasonable amount (2 X Stock Level)
- K QTYFLG Q:'$D(^PSI(58.1,PSGWDA,1,PSGDDA,0)) S STKLEV=$P(^(0),"^",2) I 'STKLEV K STKLEV Q
- I X'>(2*STKLEV) K STKLEV Q
- W *7,!!,"This quantity seems too high! The normal Stock Level for this item is ",STKLEV
- ASK W !?5,"Are you sure of this amount " S %=2 D YN^DICN I %=1 K STKLEV Q
- I %=0 W " Enter 'YES' or 'NO'" G ASK
- S QTYFLG=1 K STKLEV Q
- GETVAL S DIC("W")="W $P(^(0),""^"",8)"
- I $L(X)>1 S DIC(0)="QEM",X=$E(X,2,$L(X))
- E S DIC(0)="QEAM"
- S DIC="^PSI(58.1,"_PSGWDA_",1," D ^DIC S DA=+Y K DIC Q:Y<0 D ALIGN Q
- ALIGN ;Align on this item
- Q:'$D(^PSI(58.1,PSGWDA,1,+Y,0)) S K=^(0) D LOC S TYP=""
- TYP 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
- S PSG1=TPSG1,PSG2=TPSG2,PSG3=TPSG3
- 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
- E G TYP
- LOC ;Build item address
- S K1=$P(K,"^",8) F I=1:1:3 S @("TPSG"_I)=$S($P(K1,",",I)]"":$P(K1,",",I),1:" ")
- S PSGDR=$S($D(^PSDRUG(+K,0))#2:$P(^(0),"^",1),1:+K)
- Q
- PSGWBO1 ;BHAM ISC/CML-Enter/Edit Actual Dispensed/Backorder Values - CONTINUED ; 09/27/89 13:57
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- +2 ;
- CHKQTY ;Check Qty. Dispensed for reasonable amount (2 X Stock Level)
- +1 KILL QTYFLG
- IF '$DATA(^PSI(58.1,PSGWDA,1,PSGDDA,0))
- QUIT
- SET STKLEV=$PIECE(^(0),"^",2)
- IF 'STKLEV
- KILL STKLEV
- QUIT
- +2 IF X'>(2*STKLEV)
- KILL STKLEV
- QUIT
- +3 WRITE *7,!!,"This quantity seems too high! The normal Stock Level for this item is ",STKLEV
- ASK WRITE !?5,"Are you sure of this amount "
- SET %=2
- DO YN^DICN
- IF %=1
- KILL STKLEV
- QUIT
- +1 IF %=0
- WRITE " Enter 'YES' or 'NO'"
- GOTO ASK
- +2 SET QTYFLG=1
- KILL STKLEV
- QUIT
- GETVAL SET DIC("W")="W $P(^(0),""^"",8)"
- +1 IF $LENGTH(X)>1
- SET DIC(0)="QEM"
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 IF '$TEST
- SET DIC(0)="QEAM"
- +3 SET DIC="^PSI(58.1,"_PSGWDA_",1,"
- DO ^DIC
- SET DA=+Y
- KILL DIC
- IF Y<0
- QUIT
- DO ALIGN
- QUIT
- ALIGN ;Align on this item
- +1 IF '$DATA(^PSI(58.1,PSGWDA,1,+Y,0))
- QUIT
- SET K=^(0)
- DO LOC
- SET TYP=""
- TYP SET TYP=$ORDER(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,TPSG1,TPSG2,TPSG3,TYP))
- IF TYP=""
- WRITE *7,"??",!!,"You may only 'up-arrow' to Items from this AOU",!,"that are included in this Inventory Date/Time!!",!!,"ITEM: ",TEMPDR
- SET DA=-1
- SET PSGDR=TEMPDR
- QUIT
- +1 SET PSG1=TPSG1
- SET PSG2=TPSG2
- SET PSG3=TPSG3
- +2 IF $DATA(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,TYP,PSGDR))
- SET PSGTYP=TYP
- SET PSGDR=$EXTRACT(PSGDR,1,$LENGTH(PSGDR)-1)_$EXTRACT(" ",$EXTRACT(PSGDR,$LENGTH(PSGDR))'=" ")
- QUIT
- +3 IF '$TEST
- GOTO TYP
- LOC ;Build item address
- +1 SET K1=$PIECE(K,"^",8)
- FOR I=1:1:3
- SET @("TPSG"_I)=$SELECT($PIECE(K1,",",I)]"":$PIECE(K1,",",I),1:" ")
- +2 SET PSGDR=$SELECT($DATA(^PSDRUG(+K,0))#2:$PIECE(^(0),"^",1),1:+K)
- +3 QUIT
