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 ---[H[J[2J[HPSGWSTKI 1578 printed Dec 13, 2024@01:40:09 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
