PSGWSTKI.m

PSGWSTKI ;BHAM ISC/CML-Stock Item Enter/Edit ; 29 Dec 93 / 8:44 AM

 ;;2.3; Automatic Replenishment/Ward Stock ;**17**;4 JAN 94

AOU ; SELECT AOU

 K DA,DIC F QQ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAMZ" W ! D ^DIC K DIC Q:Y'>0  S AOU=+Y S:'$D(^PSI(58.1,AOU,1,0)) ^(0)="^58.11IP^^" D ITEM

QUIT K %,AOU,C,D0,D1,DI,DA,DQ,DR,I,ITEM,QQ,X,Y,CHK,DRGDA Q

ITEM ; SELECT ITEM

 F QQ=0:0 K DA S CHK=1,DA(1)=AOU,DIC="^PSI(58.1,"_AOU_",1,",DIC(0)="QEAMOLZ" D ^DIC K DIC Q:Y'>0  S ITEM=+Y D CHK I CHK S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR="1;13;14;3;10;5",DR(2,58.13)=".01" D ^DIE K DIE W !

 Q

CHK ; CHECK FOR CURRENT INACTIVATION DATE

 I '$D(^PSI(58.1,AOU,1,ITEM,"I")) D CHK2 Q

 D CHK2 Q:'CHK

 W *7,!!?5,"This Item is currently defined for this AOU with an INACTIVATION DATE.",!!?5,"If you want to add this Item as a new standard Stock Item for this AOU",!?5,"you must delete the INACTIVATION DATE.",!

 S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR=30 D ^DIE K DIE S CHK=$S($D(Y):0,$D(^PSI(58.1,AOU,1,ITEM,"I")):0,1:1) W !

 Q

CHK2 ; CHECK FOR NON-PHARMACY ITEMS

 S DRGDA=+^PSI(58.1,AOU,1,ITEM,0)

 S CHK=$S('$D(^PSDRUG(DRGDA,2)):1,$P(^(2),"^",3)="":1,$P(^(2),"^",3)["O":1,$P(^(2),"^",3)["U":1,$P(^(2),"^",3)["I":1,$P(^(2),"^",3)["X":1,1:$P(^(2),"^",3)["N") Q:CHK

 I '$D(^PSI(58.1,AOU,1,ITEM,"I")) S DA(1)=AOU,DA=ITEM,DIE="^PSI(58.1,"_AOU_",1,",DR=30_"///"_DT D ^DIE K DIE

 W *7,!!?5,"This item is currently defined for this AOU but appears to be a",!?5,"non-pharmacy drug.  It has been inactivated as of " S Y=$O(^PSI(58.1,AOU,1,ITEM,"I",0)) X ^DD("DD") W Y,!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWSTKI   1578     printed  Apr 09, 2024@20:45:27                                                                                                                                                                                                    Page 2

PSGWSTKI  ;BHAM ISC/CML-Stock Item Enter/Edit ; 29 Dec 93 / 8:44 AM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;**17**;4 JAN 94

AOU       ; SELECT AOU

 +1        KILL DA,DIC

           FOR QQ=0:0

               SET DIC="^PSI(58.1,"

               SET DIC(0)="QEAMZ"

               WRITE !

               DO ^DIC

               KILL DIC

               if Y'>0

                   QUIT 

               SET AOU=+Y

               if '$DATA(^PSI(58.1,AOU,1,0))

                   SET ^(0)="^58.11IP^^"

               DO ITEM

QUIT       KILL %,AOU,C,D0,D1,DI,DA,DQ,DR,I,ITEM,QQ,X,Y,CHK,DRGDA

           QUIT 

ITEM      ; SELECT ITEM

 +1        FOR QQ=0:0

               KILL DA

               SET CHK=1

               SET DA(1)=AOU

               SET DIC="^PSI(58.1,"_AOU_",1,"

               SET DIC(0)="QEAMOLZ"

               DO ^DIC

               KILL DIC

               if Y'>0

                   QUIT 

               SET ITEM=+Y

               DO CHK

               IF CHK

                   SET DA(1)=AOU

                   SET DA=ITEM

                   SET DIE="^PSI(58.1,"_AOU_",1,"

                   SET DR="1;13;14;3;10;5"

                   SET DR(2,58.13)=".01"

                   DO ^DIE

                   KILL DIE

                   WRITE !

 +2        QUIT 

CHK       ; CHECK FOR CURRENT INACTIVATION DATE

 +1        IF '$DATA(^PSI(58.1,AOU,1,ITEM,"I"))

               DO CHK2

               QUIT 

 +2        DO CHK2

           if 'CHK

               QUIT 

 +3        WRITE *7,!!?5,"This Item is currently defined for this AOU with an INACTIVATION DATE.",!!?5,"If you want to add this Item as a new standard Stock Item for this AOU",!?5,"you must delete the INACTIVATION DATE.",!

 +4        SET DA(1)=AOU

           SET DA=ITEM

           SET DIE="^PSI(58.1,"_AOU_",1,"

           SET DR=30

           DO ^DIE

           KILL DIE

           SET CHK=$SELECT($DATA(Y):0,$DATA(^PSI(58.1,AOU,1,ITEM,"I")):0,1:1)

           WRITE !

 +5        QUIT 

CHK2      ; CHECK FOR NON-PHARMACY ITEMS

 +1        SET DRGDA=+^PSI(58.1,AOU,1,ITEM,0)

 +2        SET CHK=$SELECT('$DATA(^PSDRUG(DRGDA,2)):1,$PIECE(^(2),"^",3)="":1,$PIECE(^(2),"^",3)["O":1,$PIECE(^(2),"^",3)["U":1,$PIECE(^(2),"^",3)["I":1,$PIECE(^(2),"^",3)["X":1,1:$PIECE(^(2),"^",3)["N")

           if CHK

               QUIT 

 +3        IF '$DATA(^PSI(58.1,AOU,1,ITEM,"I"))

               SET DA(1)=AOU

               SET DA=ITEM

               SET DIE="^PSI(58.1,"_AOU_",1,"

               SET DR=30_"///"_DT

               DO ^DIE

               KILL DIE

 +4        WRITE *7,!!?5,"This item is currently defined for this AOU but appears to be a",!?5,"non-pharmacy drug.  It has been inactivated as of "

           SET Y=$ORDER(^PSI(58.1,AOU,1,ITEM,"I",0))

           XECUTE ^DD("DD")

           WRITE Y,!

 +5        QUIT