source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWPL0.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PSGWPL0 ;BHAM ISC/MPH,PTD,CML-Print AOU Inventory Pick List - CONTINUED ; 09 Feb 93 / 10:08 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3ENQ ;ENTRY POINT WHEN QUEUED
4 S MSGFLG=0
5 F SK=0:0 S SK=$O(^PSI(58.19,PSGWIDA,1,"C",SK)) Q:SK'>0 F J=0:0 S J=$O(^PSI(58.19,PSGWIDA,1,"C",SK,J)) Q:J'>0 S PSGW("PO",SK,J)=""
6 S PSGWIN=$P(^PSI(58.19,PSGWIDA,0),"^"),DISPFL=""
7WLOOP F PSGSORTK=0:0 S PSGSORTK=$O(PSGW("PO",PSGSORTK)) Q:PSGSORTK'>0 F PSGDA=0:0 S PSGDA=$O(PSGW("PO",PSGSORTK,PSGDA)) Q:PSGDA'>0 D:NOPRT=0 WENT
8 W:(DISPFL="")&(NOPRT=0) !!,"NO STOCK TO BE DISPENSED FOR THIS INVENTORY." I (NOPRT=0)&(DISPFL'="") D ^PSGWPL1
9DONE I $E(IOST)'="C" W @IOF
10END W ! K G,PSG1,PSG2,PSG3,PSG1FLG,PSG3FLG,PSGTYFLG,PSGBON,PSGCS,PSGDDA,PSGDN,PSGSORTK,PSGWIDA,PSGWIN,PSGW("PO"),PSGBOT,PSGTYP,PSGWGRP,PSGWLP,PSGWPC,PSGDA,PSGDR,PSGPAGE,PSGTODAY,PSGST
11 K ^TMP("PSGWDL",$J),MSGFLG,ZTSK,I,J,K,K1,DISPFL,NOPRT,EXP,GRP,AOUFLG,LL,LP,PC,SY,SK,L,Y,X,X1,PSGDL1,PSGDL2,PSGDL3,IO("Q") D ^%ZISC
12 K:$D(PSGWFLG) PSGWSITE,PSGWFLG
13 S:$D(ZTQUEUED) ZTREQ="@" Q
14 ;
15WENT ;Sort the ward item list to determine content of Pick List
16 S PSG1="" I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA)) S AOUFLG=1
17PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1)) Q:PSG1="" S PSG1FLG=1,PSG2="",EXP=$O(^PSI(58.17,"B",PSG1,0))
18PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2)) G:PSG2="" PSG1 S PSG3=""
19PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3)) G:PSG3="" PSG2 S PSGTYP="",PSG3FLG=1
20PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP)) G:PSGTYP="" PSG3 S PSGDR="",PSGTYFLG=1
21PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) D:PSGDR'="" CHKDISP Q:NOPRT=1 G:PSGDR="" PSGTYP S PSGDDA=$P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^")
22 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)'>0 G PSGDR
23 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)>0 D LOC S DISPFL=1
24 S PSGDN=+^PSI(58.1,PSGDA,1,PSGDDA,0)
25BACKOD S PSGBOT=0,Y=$O(^PSI(58.3,"B",PSGDN,0)) G:Y="" PNT S PSGBON=+Y
26 F J=0:0 S J=$S($D(^PSI(58.3,PSGBON,1,PSGDA,1,J)):$O(^(J)),1:0) Q:J'>0 S:$S($P(^(J,0),"^",5)="":1,$P(^(0),"^",5)'<PSGWIN:1,1:0) PSGBOT=PSGBOT+$P(^(0),"^",2)
27PNT I ($Y+5>IOSL)!($D(AOUFLG)) D EN2^PSGWPL K AOUFLG
28 I $D(PSG1FLG) W !,?17,PSG1 W:EXP>0 " ",$P(^PSI(58.17,EXP,0),"^",3) K PSG1FLG
29 I $D(PSG3FLG) W !,?1,PSG2,$S(PSG3'=" ":","_PSG3,PSG3="":" ",1:"") K PSG3FLG
30 I $D(PSGTYFLG) S LL=$S($X>7:"!?7",1:"?7") W:PSGTYP'="ALL" @LL,PSGTYP K PSGTYFLG
31 W !,?10,PSGDR,?51,$J($P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",3),3) S MSGFLG=1
32QCODE F SY=0:0 S SY=$O(^PSDRUG(PSGDN,1,SY)) Q:SY'>0 I $P(^(SY,0),"^",3) W ?58,$E($P(^(0),"^"),1,10) Q
33 W ?71,$J($P(^PSI(58.1,PSGDA,1,PSGDDA,1,PSGWIDA,0),"^",6),3),?91,$J(PSGBOT,3),?105,$J($P(^(0),"^",5),3),?115,"_________"
34CSUB S PSGCS=$S($D(^PSDRUG(PSGDN,0))#2:$P(^(0),"^",3),1:"") W:PSGCS["A" !!,?83,"Controlled Substance ____________________________",!
35 G PSGDR
36 ;
37CHKDISP ;Has quantity dispensed been entered for inventory?
38 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)="" S NOPRT=1 D MSG
39 Q
40 ;
41LOC ;Build item address
42 S J=$P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^"),K=$P(^(PSGDR),"^",2)
43 S K1=$S($D(^PSDRUG(+K,"PSG"))#2:$P(^("PSG"),"^"),1:"") F I=1:1:3 S @("PSGDL"_I)=$S($P(K1,",",I)]"":$P(K1,",",I),1:" ")
44 I $D(^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)) S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$P(^(PSGDR),"^")+$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
45 E S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
46 S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
47 Q
48MSG ;Warning msg for no quantities
49 W !,$S(MSGFLG:"Pick List cannot continue printing.",1:"Pick List cannot be printed."),!,"On-hand quantity or quantity dispensed not entered.",!,"Use Input AOU Inventory OR Enter/Edit Quantity Dispensed." Q
Note: See TracBrowser for help on using the repository browser.