1 | PSGWEDI ;BHAM ISC/GRK,CML-Enter/Edit of AOU Inventory Values ; 17 Jun 93 / 10:35 AM
|
---|
2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
---|
3 | I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
|
---|
4 | I $P(PSGWSITE,"^",5) W !!?5,"You may not enter on-hand amounts because you have the ""Merge",!?5,"Inventory Sheet and Pick List"" site parameter set to ""YES""." Q
|
---|
5 | S DIC="^PSI(58.19,",DIC(0)="QEAMNZ",DIC("A")="SELECT DATE/TIME FOR INVENTORY: " D ^DIC K DIC Q:Y<0 S PSGWIDA=+Y
|
---|
6 | ;
|
---|
7 | EN1 ; PSGWIDA = DA of inventory being edited
|
---|
8 | K PSGW("PO") S PSGWV="AMIS COMPILE FLAG"
|
---|
9 | F SK=0:0 S SK=$O(^PSI(58.19,PSGWIDA,1,"C",SK)) Q:'SK F J=0:0 S J=$O(^PSI(58.19,PSGWIDA,1,"C",SK,J)) Q:'J S PSGW("PO",SK,J)=""
|
---|
10 | S (PSGWADT,PSGWIN)=$P(^PSI(58.19,PSGWIDA,0),"^",1),PSGWCAT="A",FLG=0,AMISFL=0
|
---|
11 | WLOOP F PSGSORTK=0:0 S PSGSORTK=$O(PSGW("PO",PSGSORTK)) Q:'PSGSORTK Q:FLG F PSGDA=0:0 S PSGDA=$O(PSGW("PO",PSGSORTK,PSGDA)) Q:'PSGDA D WENT Q:FLG S AMISFL=0
|
---|
12 | END D CHKGLOB K PSGW("PO"),PSG1,PSG2,PSG3,PSGWACT,PSGWAOUN,PSGWDA,PSGDDA,PSGWDN,PSGDR,PSGWOD,PSGSORTK,PSGWIN,PSGWN,PSGX,PSGDA,PSGTYP,PSGWIDA,SK,WN,X,Y,I,J,K,L,M,MIN,N,P1,P2,P3,RELEV,TYP,DRUG,A,PSGWDRG,PSGWADT,PSGWCAT,PSGWQD,FLG,PSGWV,DIC
|
---|
13 | K AMISFL,PSGWAOU,KEY,DA,K1,GRP,LP,PC,%,%Y,C K:$D(PSGWFLG) PSGWFLG,PSGWSITE Q
|
---|
14 | WENT S PSGWN=$S($D(^PSI(58.1,PSGDA,0)):$P(^(0),"^",1),1:""),DIC("B")=PSGWN
|
---|
15 | W ! S DIC="^PSI(58.19,PSGWIDA,1,",DIC(0)="AEQNMZ" D ^DIC K DIC S (PSGWDA,DA,PSGWAOU)=+Y,PSGWAOUN=$P(Y,"^",2) S:Y<0 FLG=1 Q:Y<0 S:($P(^PSI(58.1,PSGWDA,0),"^",3)'=1)&($P(PSGWSITE,"^",25)=1) AMISFL=1
|
---|
16 | S PSG1=""
|
---|
17 | PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1)) Q:PSG1="" S PSG2=""
|
---|
18 | PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2)) G PSG1:PSG2="" S PSG3=""
|
---|
19 | PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3)) G PSG2:PSG3="" S PSGTYP=""
|
---|
20 | PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP)) G PSG3:PSGTYP="" S PSGDR=""
|
---|
21 | PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) G PSGTYP:PSGDR="" S PSGDDA=+^(PSGDR),PSGWDN=$P(^(PSGDR),"^",2)
|
---|
22 | W !!," ITEM: ",PSGDR
|
---|
23 | I $D(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0)) S A=^(0)
|
---|
24 | E D EN3^PSGWEDI1
|
---|
25 | F J=1:1:6 S PSGX(J)=$P(A,"^",J)
|
---|
26 | ONH W !,"ON-HAND: " W:PSGX(6)'="" PSGX(6),"//" R X:DTIME S:'$T FLG=1 Q:'$T W:PSGX(6)=""&(X="") PSGX(2) S:X="" X=PSGX(6) Q:X="^" S:X="" X=PSGX(2) I X["^" S PSGWDRG=X D EN1^PSGWEDI1 G:DA<0 ONH G PSGDR
|
---|
27 | I "?"[$E(X)!(X<0)!(X>9999)!(X'?1N.N) W *7,!,"Enter quantity presently on-hand in the ward at the time of inventory.",!,"Must be a number between 0 and 9999." G ONH
|
---|
28 | S PSGX(6)=$S(X="@":"",1:X),RELEV=$P(^PSI(58.1,PSGWDA,1,PSGDDA,0),"^",11),MIN=$P(^(0),"^",12) D DISP
|
---|
29 | DUMP S (PSGWOD,PSGWACT,PSGWQD)=PSGX(5) I (AMISFL=1)&(PSGWQD'=0) S ^PSI(58.5,"AMIS",$H,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
|
---|
30 | S ^(PSGDR)=$P(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",1,3)_"^"_PSGX(5)
|
---|
31 | S A="" F J=1:1:6 S A=A_PSGX(J)_"^"
|
---|
32 | S ^(0)=A_$P(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0),"^",7,999)
|
---|
33 | D:PSGX(5)'=0 ^PSGWFLBO G PSGDR
|
---|
34 | ;
|
---|
35 | CHKGLOB ;Set piece 4 of global to 0 if null.
|
---|
36 | AOU S (P1,P2,P3,TYP,DRUG)=0 F I=0:0 S I=$O(^PSI(58.19,"AINV",PSGWIDA,I)) Q:'I D P1
|
---|
37 | Q
|
---|
38 | P1 F J=0:0 S P1=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1)) Q:P1="" D P2
|
---|
39 | Q
|
---|
40 | P2 F K=0:0 S P2=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2)) Q:P2="" D P3
|
---|
41 | Q
|
---|
42 | P3 F L=0:0 S P3=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3)) Q:P3="" D TYP
|
---|
43 | Q
|
---|
44 | TYP F M=0:0 S TYP=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP)) Q:TYP="" D DRUG
|
---|
45 | Q
|
---|
46 | DRUG F N=0:0 S DRUG=$O(^PSI(58.19,"AINV",PSGWIDA,I,P1,P2,P3,TYP,DRUG)) Q:DRUG="" I $P(^(DRUG),"^",4)="" S $P(^(DRUG),"^",4)=0
|
---|
47 | Q
|
---|
48 | DISP ;CALCULATE DISPENSE AMT
|
---|
49 | S PSGX(5)=PSGX(2)-PSGX(6) S:PSGX(5)<0 PSGX(5)=0 I RELEV']"" Q
|
---|
50 | I PSGX(6)>+RELEV S PSGX(5)=0 Q
|
---|
51 | I PSGX(5)<+MIN S PSGX(5)=+MIN
|
---|
52 | Q
|
---|