PSOSUINV.m

PSOSUINV ;BHAM ISC/SAB-UPDATE OR INITIALIZE INVENTORY ; 04/02/93 9:55

 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 W ! S DIR("A",1)="1     Update Current Inventory",DIR("A",2)="2     Initialize Inventory"

 S DIR("A")="CHOOSE 1 OR 2> ",DIR(0)="SAO^1:Update Current Inventory;2:Initialize Inventory" D ^DIR G:$D(DUOUT)!($D(DIROUT))!($D(DIRUT))!(Y="") EX K DIR S F=Y-1

A W ! S (DIE,DIC)="^PSDRUG(",DIC(0)="QEAM",DIC("W")="I $D(^PSDRUG(Y,""I"")),^(""I""),^(""I"")'>DT W $C(7),?45,""INACTIVE DRUG""" D ^DIC G:"^"[X EX G:Y<0 A

 K DIC S DA=+Y,DR="12;15;13;1000:99999;W !,$P(^DD(50,16,0),""^"",1),"" is "" W:$D(^PSDRUG(DA,660)) $P(^(660),""^"",6)"

 W !!,$P(^PSDRUG(DA,0),"^"),?45,"CURRENT INVENTORY: ",$S($D(^(660.1)):^(660.1),1:0) D ^DIE G A:'$D(^PSDRUG(DA,660))!($D(Y))

B R !,"UNITS RECEIVED: ",X:DTIME S:'$T X="^" G A:"^"[X,Q:X?1"?".E,U:X?1N.N1"D" S X=X*$P(^PSDRUG(DA,660),"^",5)

U S X=+X I X'?1N.N W $C(7),"  ??" G Q

 W !,$S(F:"SET INVENTORY TO ",1:"UPDATE INVENTORY BY "),X," UNITS?  YES//" R Y:DTIME G B:"Y"'[$E(Y,1) S ^PSDRUG(DA,660.1)=$S(F:X,'$D(^PSDRUG(DA,660.1)):X,1:^(660.1)+X) W ?45,"NEW INVENTORY: ",^(660.1) G A

Q W !!?5,"ENTER THE NUMBER OF ORDER UNITS (CASES, BOXES, BOTTLES, ETC.) RECEIVED."

 W !?5,"IF YOU WISH TO UPDATE THE INVENTORY BY DISPENSING UNITS, TYPE THE NUMBER"

 W !?5,"OF UNITS FOLLOWED BY THE LETTER 'D'.",! G B

 Q

EX K DIR,DUOUT,DTOUT,DIRUT,DIC,DIE,X,Y,DA,DR,DIR,F,DI,D0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOSUINV   1407     printed  Apr 09, 2024@21:27:49                                                                                                                                                                                                    Page 2

PSOSUINV  ;BHAM ISC/SAB-UPDATE OR INITIALIZE INVENTORY ; 04/02/93 9:55

 +1       ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 +2        WRITE !

           SET DIR("A",1)="1     Update Current Inventory"

           SET DIR("A",2)="2     Initialize Inventory"

 +3        SET DIR("A")="CHOOSE 1 OR 2> "

           SET DIR(0)="SAO^1:Update Current Inventory;2:Initialize Inventory"

           DO ^DIR

           if $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DIRUT))!(Y="")

               GOTO EX

           KILL DIR

           SET F=Y-1

A          WRITE !

           SET (DIE,DIC)="^PSDRUG("

           SET DIC(0)="QEAM"

           SET DIC("W")="I $D(^PSDRUG(Y,""I"")),^(""I""),^(""I"")'>DT W $C(7),?45,""INACTIVE DRUG"""

           DO ^DIC

           if "^"[X

               GOTO EX

           if Y<0

               GOTO A

 +1        KILL DIC

           SET DA=+Y

           SET DR="12;15;13;1000:99999;W !,$P(^DD(50,16,0),""^"",1),"" is "" W:$D(^PSDRUG(DA,660)) $P(^(660),""^"",6)"

 +2        WRITE !!,$PIECE(^PSDRUG(DA,0),"^"),?45,"CURRENT INVENTORY: ",$SELECT($DATA(^(660.1)):^(660.1),1:0)

           DO ^DIE

           if '$DATA(^PSDRUG(DA,660))!($DATA(Y))

               GOTO A

B          READ !,"UNITS RECEIVED: ",X:DTIME

           if '$TEST

               SET X="^"

           if "^"[X

               GOTO A

           if X?1"?".E

               GOTO Q

           if X?1N.N1"D"

               GOTO U

           SET X=X*$PIECE(^PSDRUG(DA,660),"^",5)

U          SET X=+X

           IF X'?1N.N

               WRITE $CHAR(7),"  ??"

               GOTO Q

 +1        WRITE !,$SELECT(F:"SET INVENTORY TO ",1:"UPDATE INVENTORY BY "),X," UNITS?  YES//"

           READ Y:DTIME

           if "Y"'[$EXTRACT(Y,1)

               GOTO B

           SET ^PSDRUG(DA,660.1)=$SELECT(F:X,'$DATA(^PSDRUG(DA,660.1)):X,1:^(660.1)+X)

           WRITE ?45,"NEW INVENTORY: ",^(660.1)

           GOTO A

Q          WRITE !!?5,"ENTER THE NUMBER OF ORDER UNITS (CASES, BOXES, BOTTLES, ETC.) RECEIVED."

 +1        WRITE !?5,"IF YOU WISH TO UPDATE THE INVENTORY BY DISPENSING UNITS, TYPE THE NUMBER"

 +2        WRITE !?5,"OF UNITS FOLLOWED BY THE LETTER 'D'.",!

           GOTO B

 +3        QUIT 

EX         KILL DIR,DUOUT,DTOUT,DIRUT,DIC,DIE,X,Y,DA,DR,DIR,F,DI,D0

 +1        QUIT