source: FOIAVistA/tag/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWUTL.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PSGWUTL ;BHAM ISC/CML,KKA-Utility routine for FileMan functions ; 06 Dec 93 / 2:23 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;**17**;4 JAN 94
3OND ;Check quantities for On-Demands/Returns
4 Q:'$D(^PSI(58.1,DA(2),1,DA(1),0)) Q:'$P(^(0),"^",2) I X'>(2*$P(^(0),"^",2)) Q
5 W *7,!!,"This quantity seems too high! The normal Stock Level for this item is ",$P(^PSI(58.1,DA(2),1,DA(1),0),"^",2)
6ASK W !?5,"Are you sure of this amount " S %=2 D YN^DICN I %=1 K %,%Y Q
7 I %=0!(%=-1) W " Enter 'YES' or 'NO'" G ASK
8 K X,%,%Y Q
9QUIT K %,%Y,ADT,AOU,LP,II,ITM Q
10 ;SUBROUTINES FOR AMIS XREFS
11QD ;SET "AMIS" XREF FOR QTY DISPENSED
12 Q:$D(PSGWV) I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),1,DA,0),"^",4)'=1 Q:'$D(^PSI(58.19,DA)) S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"A",AOU,ITM,X)=""
13 G QUIT
14KQD ;KILL "AMIS" XREF FOR QTY DISPENSED
15 Q:$D(PSGWV) Q:'$D(^PSI(58.19,DA)) S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP I $D(^PSI(58.5,"AMIS",LP,ADT,"A",AOU,ITM)) K ^(ITM)
16 G QUIT
17OD ;SET "AMIS" XREF FOR ON-DEMAND REQUEST
18 Q:$D(PSGWV) I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),5,DA,0),"^",4)'=1 S ADT=$P(^(0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"W",AOU,ITM,X)=""
19 G QUIT
20KOD ;KILL "AMIS" XREF FOR ON-DEMAND REQUEST
21 Q:$D(PSGWV) S ADT=$P(^PSI(58.1,DA(2),1,DA(1),5,DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP I $D(^PSI(58.5,"AMIS",LP,ADT,"W",AOU,ITM)) K ^(ITM)
22 G QUIT
23RET ;SET "AMIS" XREF FOR RETURNS
24 Q:$D(PSGWV) I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),3,DA,0),"^",4)'=1 S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMIS",$H,ADT,"R",AOU,ITM,X)=""
25 G QUIT
26KRET ;KILL "AMIS" XREF FOR RETURNS
27 Q:$D(PSGWV) S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,AOU,1,DA(1),0),"^"),LP="" F II=0:0 S LP=$O(^PSI(58.5,"AMIS",LP)) Q:'LP I $D(^PSI(58.5,"AMIS",LP,ADT,"R",AOU,ITM)) K ^(ITM)
28 G QUIT
29QDERR ;SET "AMISERR" XREF ON QTY DISPENSED
30 Q:$D(PSGWV) I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
31 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),1,DA,0),"^",4)'=1 Q:'$D(^PSI(58.19,DA)) S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"A",ITM,X)=""
32 G QUIT
33KQDERR ;KILL "AMISERR" XREF ON QTY DISPENSED
34 Q:$D(PSGWV) Q:'$D(^PSI(58.19,DA)) S ADT=$P(^(DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
35 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
36 G QUIT
37ODERR ;SET "AMISERR" XREF ON ON-DEMANDS
38 Q:$D(PSGWV) I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
39 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),5,DA,0),"^",4)'=1 S ADT=$P(^(0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"W",ITM,X)=""
40 G QUIT
41KODERR ;KILL "AMISERR" XREF ON ON-DEMANDS
42 Q:$D(PSGWV) S ADT=$P(^PSI(58.1,DA(2),1,DA(1),5,DA,0),"^"),AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
43 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
44 G QUIT
45RETERR ;SET "AMISERR" XREF ON RETURNS
46 Q:$D(PSGWV) I $D(^PSI(58.1,DA(2),"SITE")),^("SITE")]"" Q
47 I X'=0,$P(^PSI(58.1,DA(2),0),"^",3)'=1,$P(^(1,DA(1),3,DA,0),"^",4)'=1 S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),^PSI(58.5,"AMISERR",AOU,$H,ADT,"R",ITM,X)=""
48 G QUIT
49KRETERR ;KILL "AMISERR" XREF ON RETURNS
50 Q:$D(PSGWV) S ADT=DA,AOU=DA(2),ITM=$P(^PSI(58.1,DA(2),1,DA(1),0),"^"),LP=""
51 F II=0:0 S LP=$O(^PSI(58.5,"AMISERR",AOU,LP)) Q:'LP I $D(^PSI(58.5,"AMISERR",AOU,LP,ADT,"A",ITM)) K ^(ITM)
52 G QUIT
53INACT ;CHECK FOR INACTIVE DATE ON ITEM FOR "D" XREF (FILE 58.1)
54 K PSGWFLG I '$D(^PSI(58.1,DA(2),1,DA(1),"I")) S PSGWFLG=1 Q
55 S:$O(^PSI(58.1,DA(2),1,DA(1),"I"))>DT PSGWFLG=1 Q
56DRGSCRN ;SCREEN DRUG FILE DRUGS FOR AR/WS FOR ^DD(58.11,.01,0) AND ^DD(58.11,.01,12.1)
57 ; naked indicator set within VA FileMan in file 58.11
58 ; this code is called as part of the input transform
59 I $S('$D(^("I")):1,+^("I")>DT:1,1:0) S APU=$P($G(^(2)),"^",3) I $S(APU="":1,APU["O":1,APU["U":1,APU["I":1,APU["X":1,1:APU["N")
60 K APU Q
61DRGSCRN2 ;
62 S DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0) S APU=$P($G(^(2)),""^"",3) I $S(APU="""":1,APU[""O"":1,APU[""U"":1,APU[""I"":1,APU[""X"":1,1:APU[""N"")"
63 D ^DIC K DIC S DIC=DIE,X=+Y
64 I Y<0 W !,"Enter name of drug being stocked in this AOU." K X
65 K APU Q
66EDCHK ;
67 I $O(^PSI(58.1,D0,1,+$G(D1),0)) S Y=-1 K X W !," NO EDITING -- This item has activity. "
68 Q
Note: See TracBrowser for help on using the repository browser.