PSGWBO1.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWBO1   1435     printed  Apr 09, 2024@20:44:55                                                                                                                                                                                                     Page 2

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