source: FOIAVistA/tag/r/DRUG_ACCOUNTABILITY-PSA/PSADRUGP.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1PSADRUGP ;BIR/LTL,JMB-Enter/Edit a Drug ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,60,64**; 10/24/97;Build 4
3 ;
4 ;References to ^PSDRUG( are covered by IA #2095
5 ;References to ^PS(52.6, are covered by IA #270
6 ;References to ^DIC(51.5 are covered by IA #1931
7 ;References to ^PS(52.7 are covered by IA #770
8LOC G:+$G(PSAOUT)&($G(PSACNT)=1) EXIT
9 S (PSADD,PSACNT,PSAOUT)=0,PSASLN="",$P(PSASLN,"-",80)=""
10 D ^PSAUTL3 G:PSAOUT EXIT S PSACHK=$O(PSALOC(""))
11 I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT
12 I $O(PSALOC(PSACHK))="" W !,PSALOCN
13 ;
14GETDRUG S PSAQTY=0
15 S:'$D(^PSD(58.8,PSALOC,1,0)) ^(0)="^58.8001IP^^"
16 S DA(1)=PSALOC,DIC="^PSD(58.8,"_PSALOC_",1,",DIC(0)="AEMQL",DIC("W")="I $S($P($G(^(0)),U,14):$P($G(^(0)),U,14)'>DT,1:0) W $C(7),"" *** INACTIVE ***""",DLAYGO=58.8 W ! D ^DIC K DIC,DLAYGO
17 I Y<0!($G(DTOUT))!($G(DUOUT)) S PSAOUT=1 Q:$G(PSAOPT)="PSALOC" G LOC
18 S PSADRG=+Y,PSADRGN=$P($G(^PSDRUG(PSADRG,0)),"^")
19 I $D(^PSD(58.8,PSALOC,1,PSADRG,0)),+$P(^(0),"^",14),$P(^(0),"^",14)'>DT W !,$C(7)," *** INACTIVE ***" G DISP ;PSA*3*21 (Allow re-activation)
20 S PSA660=$G(^PSDRUG(PSADRG,660))
21 I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) G NOINV
22 I $D(^PSD(58.8,PSALOC,1,PSADRG,0)),$P(^(0),"^",4)="" G DRUG
23 G DISP
24 ;
25NOINV I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) D
26 .S:'$D(^PSD(58.8,PSALOC,1,0)) ^(0)="^58.8001IP^^"
27 .K DA,DD,DO S DIC="^PSD(58.8,"_PSALOC_",1,",DIC(0)="LM",DA(1)=PSALOC,(X,DINUM)=PSADRG,DLAYGO=58.8 D ^DIC K DIC,DINUM,DLAYGO
28DRUG S DIE="^PSD(58.8,"_PSALOC_",1,",DA(1)=PSALOC,DA=PSADRG,DR="3Enter total "_$P(PSA660,"^",8)_" currently on hand: "
29 W @IOF,!,$G(PSALOCN),!,"DRUG: "_PSADRGN
30 D:+$P(PSA660,"^",2)
31 .W !!?30,"DRUG FILE info:",!
32 .W ?20,"Order unit: "_$P(^DIC(51.5,$P(PSA660,"^",2),0),"^",1),!?20,"Dispense units per order unit: "_$P(PSA660,"^",5),!?20,"Dispense unit: "_$P(PSA660,"^",8)
33 .W !!,"Current Inventory from the DRUG file = "_$P($G(^PSDRUG(PSADRG,660.1)),"^")
34 I '$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4) D
35 .W !!,"Once an initial quantity is entered, it can only be updated by receiving,",!,"dispensing, adjusting, or transferring."
36 .W:+$P(PSA660,"^",2) " The Current Inventory from the",!,"DRUG file is only offered as an initial balance and and is NOT updated."
37 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
38 W ! D ^DIE L -^PSD(58.8,PSALOC,1,PSADRG,0) K DA,DIE G:$D(Y) LOC
39 S PSAQTY=X
40 I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) D
41 .S DIE="^PSD(58.8,"_PSALOC_",1,",DA(1)=PSALOC,DA=PSADRG,DR="2Stock Level: ;4Reorder Level: "
42 .F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
43 .D ^DIE L -^PSD(58.8,PSALOC,1,PSADRG,0) K DA,DIE
44DISP ;
45 S:'$D(PSA660) PSA660=$G(^PSDRUG(PSADRG,660)) ;*60
46 W !!,"Current balance: "_+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4)," ",$P(PSA660,"^",8)
47 ;PSA*3*21 (Give option of inactivation - Dave B)
48 S DIE="^PSD(58.8,"_PSALOC_",1,",DA(1)=PSALOC,DA=PSADRG,DR="13;14" D ^DIE K DIE,DR
49 S PSAIT=PSADRG,PSAIT(2)=PSADRGN,PSAIT(4)=$G(^PSDRUG(PSAIT,660)) D:$O(^PS(52.6,"AC",PSADRG,0))!($O(^PS(52.7,"AC",PSADRG,0))) ^PSAPSI4
50 G:'$G(PSAQTY) GETDRUG
51 D NOW^%DTC S PSADT=+$E(%,1,12)
52MON S:'$D(^PSD(58.8,PSALOC,1,PSADRG,5,0)) ^PSD(58.8,PSALOC,1,PSADRG,5,0)="^58.801A^^"
53 I '$D(^PSD(58.8,PSALOC,1,PSADRG,5,+($E(DT,1,5)*100),0)) S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="LM",(X,DINUM)=($E(DT,1,5)*100),DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DA,DIC,DLAYGO
54 S DIE="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DA(2)=PSALOC,DA(1)=PSADRG,DA=($E(DT,1,5)*100),DR="1////^S X=PSAQTY;7////^S X=PSAQTY" D ^DIE K DA,DIE
55 W !!,"Updating beginning balance and transaction history."
56 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
57FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND
58 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC
59 L -^PSD(58.81,0) K DIC,DLAYGO
60 S DIE="^PSD(58.81,",DA=PSAT,DR="1////11;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSAQTY;6////^S X=DUZ;9////0" D ^DIE K DIE,DA
61 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,4,0)) ^PSD(58.8,PSALOC,1,PSADRG,4,0)="^58.800119PA^^"
62 S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",4,",DIC(0)="LM",(X,DINUM)=PSAT
63 S DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DA,DIC,DLAYGO
64 G GETDRUG
65EXIT K %,DA,DIC,DIE,DINUM,DR,DTOUT,DUOUT,PSA660,PSACHK,PSACNT,PSADD,PSADRG,PSADRGN,PSADT,PSALOC,PSALOCA,PSALOCN,PSAOUT,PSAQTY,PSASLN,PSAT,X,Y
66 Q
Note: See TracBrowser for help on using the repository browser.