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

PSGWPI1 ;BHAM ISC/MPH,CML-Print AOU Inventory Sheet - CONTINUED ; 18 Jun 93 / 10:40 AM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
EN1 ; PSGWIDA = DA of inventory being edited
 K PSGW("PO") S PSGPAGE=1,Y=DT X ^DD("DD") S PSGTODAY=Y,LNCNT=0
 I $D(BARFLG) F J=0,1 S @("PSGWBAR"_J)="" I $D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR"_J)) S @("PSGWBAR"_J)=^("BAR"_J)
 I $D(BARFLG) S PSGWBARS=PSGWBAR1]""&(PSGWBAR0]"")
 I $D(AOU) S PSGW("PO",100,AOU)="" G START ; Check for single AOU print
 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)=""
START S PSGWIN=$P(^PSI(58.19,PSGWIDA,0),"^",1)
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 SIN,WENT
END W:$D(STKCHG) !!,"* Indicates change in stock level"
 I $E(IOST)'="C" W @IOF
 Q
 ;
SIN ;Sort the ward item list
 K ^PSI(58.19,"AINV",PSGWIDA,PSGDA) S (PSGNT,J)=0,PSGTN="" F I=0:0 S I=$O(^PSI(58.19,PSGWIDA,1,PSGDA,1,I)) Q:I'>0  S PSGTN=PSGTN_I_",",PSGNT=PSGNT+1
SINL S J=$O(^PSI(58.1,PSGDA,1,J)) Q:J'>0  S K=^(J,0)
 F I=1:1:PSGNT I $S($D(^PSI(58.1,PSGDA,1,J,2,$P(PSGTN,",",I))):1,$D(^PSI(58.16,$P(PSGTN,",",I),0)):$P(^(0),"^")="ALL",1:0) D CHKINA G:$T SINL
 G SINL
 ;
CHKINA I $S('$D(^PSI(58.1,PSGDA,1,J,"I")):1,$O(^("I",PSGWDT))>0:1,$P(^PSI(58.1,PSGDA,1,J,0),"^",10)="Y":1,1:0) D LOC S ^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)=+J_"^"_$P(K,"^",1,2)
 Q
 ;
LOC ;Build item address
 S K1=$P(K,"^",8) F NN=1:1:3 S @("PSG"_NN)=$S($P(K1,",",NN)]"":$P(K1,",",NN),1:" ")
 S PSGDR=$S($D(^PSDRUG(+K,0))#2:$P(^(0),"^",1),1:+K)
 S PSGTYP=$S($D(^PSI(58.16,$P(PSGTN,",",I),0)):$P(^(0),"^"),1:"TYPE HAS BEEN DELETED")
 I '$D(^PSI(58.1,PSGDA,1,J,1,PSGWIDA,0)) D EN2^PSGWPI2
 Q
 ;
WENT S PSG1="" I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA)) D EN1^PSGWPI2
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1)) Q:PSG1=""  W !,?17,PSG1 S PSG2="",EXP=$O(^PSI(58.17,"B",PSG1,0)) W:EXP>0 "  ",$P(^PSI(58.17,EXP,0),"^",3) S LNCNT=LNCNT+1
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2)) G PSG1:PSG2="" S PSG3=""
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3)) G PSG2:PSG3="" S PSGTYP="" W !,?1,PSG2,$S(PSG3'=" ":","_PSG3,PSG3="":" ",1:"") S LNCNT=LNCNT+1
PSGTYP I $D(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,"ALL")) S TYPE="" F Q=0:0 S TYPE=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,TYPE)) Q:TYPE=""  I TYPE'="ALL" K ^(TYPE)
 S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP)) G PSG3:PSGTYP="" S PSGDR="" S LFC=$S($X>7:"!?7",1:"?7") W:PSGTYP'="ALL" @LFC,PSGTYP
PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) G PSGTYP:PSGDR="" S PSGDDA=+^(PSGDR),DRGDA=+$P(^(PSGDR),"^",2),STLEV=$P(^(PSGDR),"^",3),LOC=^PSI(58.1,PSGDA,1,PSGDDA,0)
 I $D(BARFLG) D:LNCNT>45 EN1^PSGWPI2 D BARWRT^PSGWPI2 G PSGDR
 D:$Y+5>IOSL EN1^PSGWPI2
PNT W !,?10,PSGDR I $P(LOC,"^",5)="Y" W ?50,"*" S STKCHG="Y" S $P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",5)=""
 I (($P(LOC,"^",3)'>PSGWDT)&($P(LOC,"^",10)="Y")) W ?50,"*" S PSGINAD="Y" S $P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",10)=""
 W ?51,$J(STLEV,3)
QCODE F MH=0:0 S MH=$O(^PSDRUG($P(^PSI(58.1,PSGDA,1,PSGDDA,0),"^",1),1,MH)) Q:MH'>0  I $P(^(MH,0),"^",3) W ?58,$E($P(^(0),"^",1),1,8) Q
 W ?66,"_____"
 I $P(PSGWSITE,"^",5) W ?75,$S($P(LOC,"^",11)]"":$J($P(LOC,"^",11),5),1:" "),?86,$S(+$P(LOC,"^",12):$J($P(LOC,"^",12),5),1:" "),?98,"______"
 I $P(PSGWSITE,"^",6) S TAB1=$S($P(PSGWSITE,"^",5):109,1:74),TAB2=$S($P(PSGWSITE,"^",5):118,1:82) W ?TAB1,"______",?TAB2,"E  O  D  C"
 I $D(^PSI(58.1,PSGDA,1,PSGDDA,"EXP")) S Y=^("EXP") I Y X ^DD("DD") W !?14,"Expiration Date: ",Y
 I $D(PSGINAD) W !?14,"*Inactivated item, pull existing stock" K PSGINAD
 G PSGDR