source: FOIAVistA/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWPL0.m@ 1801

PSGWPL0 ;BHAM ISC/MPH,PTD,CML-Print AOU Inventory Pick List - CONTINUED ; 09 Feb 93 / 10:08 AM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
 S MSGFLG=0
 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)=""
 S PSGWIN=$P(^PSI(58.19,PSGWIDA,0),"^"),DISPFL=""
WLOOP 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
 W:(DISPFL="")&(NOPRT=0) !!,"NO STOCK TO BE DISPENSED FOR THIS INVENTORY." I (NOPRT=0)&(DISPFL'="") D ^PSGWPL1
DONE I $E(IOST)'="C" W @IOF
END 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
 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
 K:$D(PSGWFLG) PSGWSITE,PSGWFLG
 S:$D(ZTQUEUED) ZTREQ="@" Q
 ;
WENT ;Sort the ward item list to determine content of Pick List
 S PSG1="" I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA)) S AOUFLG=1
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1)) Q:PSG1=""  S PSG1FLG=1,PSG2="",EXP=$O(^PSI(58.17,"B",PSG1,0))
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2)) G:PSG2="" PSG1 S PSG3=""
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3)) G:PSG3="" PSG2 S PSGTYP="",PSG3FLG=1
PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP)) G:PSGTYP="" PSG3 S PSGDR="",PSGTYFLG=1
PSGDR 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),"^")
 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)'>0 G PSGDR
 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)>0 D LOC S DISPFL=1
 S PSGDN=+^PSI(58.1,PSGDA,1,PSGDDA,0)
BACKOD S PSGBOT=0,Y=$O(^PSI(58.3,"B",PSGDN,0)) G:Y="" PNT S PSGBON=+Y
 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)
PNT I ($Y+5>IOSL)!($D(AOUFLG)) D EN2^PSGWPL K AOUFLG
 I $D(PSG1FLG) W !,?17,PSG1 W:EXP>0 " ",$P(^PSI(58.17,EXP,0),"^",3) K PSG1FLG
 I $D(PSG3FLG) W !,?1,PSG2,$S(PSG3'=" ":","_PSG3,PSG3="":" ",1:"") K PSG3FLG
 I $D(PSGTYFLG) S LL=$S($X>7:"!?7",1:"?7") W:PSGTYP'="ALL" @LL,PSGTYP K PSGTYFLG
 W !,?10,PSGDR,?51,$J($P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",3),3) S MSGFLG=1
QCODE 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
 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,"_________"
CSUB S PSGCS=$S($D(^PSDRUG(PSGDN,0))#2:$P(^(0),"^",3),1:"") W:PSGCS["A" !!,?83,"Controlled Substance ____________________________",!
 G PSGDR
 ;
CHKDISP ;Has quantity dispensed been entered for inventory?
 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)="" S NOPRT=1 D MSG
 Q
 ;
LOC ;Build item address
 S J=$P(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^"),K=$P(^(PSGDR),"^",2)
 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:" ")
 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)
 E  S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
 S ^TMP("PSGWDL",$J,PSGDL1,PSGDL2,PSGDL3,PSGDR,PSGDA)=$P(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0),"^",5)
 Q
MSG ;Warning msg for no quantities
 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