PSGWL ;BHAM ISC/GRK,CML-Build AOU Inventory List ; 26 Nov 93 / 10:20 AM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
BAR S BARFLG=1 W !!,"This option will print a bar coded Inventory Sheet.  In order to do so, you",!,"must queue the output to a printer that is properly set up to produce bar codes.",!
ASKINV S (DIC,DLAYGO)=58.19,DIC(0)="QEAMLNZ",DIC("A")="SELECT DATE/TIME FOR INVENTORY: " D ^DIC K DIC,DLAYGO Q:Y<0  S PSGWIDA=+Y
 I $P(^PSI(58.19,PSGWIDA,0),"^",4)'="" S PSGWGRP=$P(^(0),"^",4)
 E  S PSGWGRP=","
 D ASKWIG G:X="^" OUT S $P(^PSI(58.19,PSGWIDA,0),"^",4)=$S($D(PSGWGRP)&(PSGWGRP'=","):PSGWGRP,1:"")
INV I $P(^PSI(58.19,PSGWIDA,0),"^",4)'="" R !!,"Do you wish to print the AOU Inventory Sheet: YES// ",X:DTIME S:'$T X="^" S:X="" X="Y" G:(X="^")!("Nn"[$E(X)) OUT G ^PSGWPI:"yY"[$E(X) G:"yY"'[$E(X) HELP
OUT K BARFLG,CHK,DIC,DIE,DR,GROUP,PSGD,PSGSORT,PSGWPGD,PSGISORT,PSGLSORT,PSGWDUP,PSGSW,PSGT,PSGW,PSGWN,PSGWIDA,PSGWGRP,Q,X,Y,AA,D1,DA,SKK,GRP,LP,PC,PSGWSK,PSGWSKP,PSGWS Q
 ;
ASKWIG R !!,"Select AOU INVENTORY GROUP: ",X:DTIME S:'$T X="^" Q:"^"[X  I $E(X,1)="^" Q:X'="^AOU"
 I X?."?" W !!,"AOU INVENTORY GROUPS currently chosen:",! F Q=2:1 S GROUP(Q)=$P(PSGWGRP,",",Q) W ! Q:GROUP(Q)=""  W $P(^PSI(58.2,GROUP(Q),0),"^")
 I $E(X,1,1)'="^" D WIG,WIBLD:Y'<0 S:PSGD'<0 PSGWPGD=PSGD D GRPNAME:PSGD'<0 G ASKWIG
 ;
 S:'$D(PSGSORT) PSGSORT=0 S DA=PSGWIDA,DR=".5",DR(2,58.24)="1",DIE="^PSI(58.19," D ^DIE G:$D(Y) ASKWIG S:$D(DA) PSGW=DA S PSGSORT=PSGSORT+100 D DUPAOU,XREF K DR G ASKWIG
 ;
WIG K PSGSW I $E(X,1)="-" S X=$E(X,2,999),PSGSW=""
 S DIC("DR")="[PSGW WARD INVENTORY]",DIC="^PSI(58.2,",DIC(0)="QEMZ",DIC("S")="I $D(^PSI(58.2,""WS"",+Y))" D ^DIC K DIC S PSGD=+Y
 I '$D(PSGSW) S CHK=","_PSGD_"," I PSGWGRP[CHK W *7,!!,"** This AOU INVENTORY GROUP has already been selected **" S (PSGD,Y)=-1
 Q
 ;
WIBLD W ! F PSGSORT=0:0 S PSGSORT=$O(^PSI(58.2,PSGD,1,"D",PSGSORT)) Q:'PSGSORT  S PSGW=$O(^PSI(58.2,PSGD,1,"D",PSGSORT,0)) D WID,WSTUF:$D(PSGSW) I '$D(PSGSW) D DUPAOU F PSGT=0:0 S PSGT=$O(^PSI(58.2,PSGD,1,PSGW,1,PSGT)) Q:'PSGT  D WSTUF
 W $S($D(PSGSW):"Deleted",1:"Added") Q
 ;
GRPNAME I '$D(PSGSW) S PSGWGRP=PSGWGRP_PSGD_"," Q
 I PSGWGRP[PSGD S PSGWGRP=$P(PSGWGRP,","_PSGD_",",1)_","_$P(PSGWGRP,","_PSGD_",",2,99)
 Q
 ;
WID S PSGWN=$S($D(^PSI(58.1,PSGW,0)):$P(^(0),"^",1),1:"") W PSGWN," "
 Q
 ;
WSTUF S DA=PSGWIDA,DIE="^PSI(58.19,"
 I $D(PSGSW) Q:'$D(^PSI(58.19,DA,1,PSGW,0))  S DR=".5///"_PSGWN,DR(2,58.24)=".01///@" D ^DIE K DR Q
 I '$D(^PSI(58.19,PSGWIDA,1,PSGW,0)) D ADDAOU S ^PSI(58.19,PSGWIDA,1,PSGW,0)=PSGW_"^"_PSGISORT
 I '$D(^PSI(58.19,PSGWIDA,1,PSGW,1,PSGT,0)) D ADDTYPE S ^PSI(58.19,PSGWIDA,1,PSGW,1,PSGT,0)=PSGT
XREF I '$D(^PSI(58.19,PSGWIDA,1,"B",PSGW,PSGW)) S ^(PSGW)=""
 I 'PSGWDUP,'$D(^PSI(58.19,PSGWIDA,1,"C",PSGISORT,PSGW)) S ^(PSGW)=""
 Q
ADDAOU I '$D(^PSI(58.19,PSGWIDA,1,0)) S ^(0)="^58.24PA^"_PSGW_"^1"
 E  S (^(0))=$P(^PSI(58.19,PSGWIDA,1,0),"^",1,2)_"^"_$S($P(^(0),"^",3)<PSGW:PSGW,1:$P(^(0),"^",3))_"^"_($P(^(0),"^",4)+1)
 Q
ADDTYPE I '$D(^PSI(58.19,PSGWIDA,1,PSGW,1,0)) S ^(0)="^58.25PA^"_PSGT_"^1"
 E  S (^(0))=$P(^PSI(58.19,PSGWIDA,1,PSGW,1,0),"^",1,2)_"^"_$S($P(^(0),"^",3)<PSGT:PSGT,1:$P(^(0),"^",3))_"^"_($P(^(0),"^",4)+1)
 Q
DUPAOU S PSGWDUP=0 F SKK=0:0 S SKK=$O(^PSI(58.19,PSGWIDA,1,"C",SKK)) Q:'SKK  F AA=0:0 S AA=$O(^PSI(58.19,PSGWIDA,1,"C",SKK,AA)) Q:'AA  I AA=PSGW S PSGWDUP=1 Q
SORTCK Q:PSGWDUP  I $D(PSGWPGD),(PSGWPGD'=PSGD) S PSGISORT=PSGLSORT+100
 E  S PSGISORT=PSGSORT
 S PSGLSORT=PSGISORT
 K SKK,AA
 Q
 ;
HELP W *7,*7,!!,"Enter ""N"" or ""NO"", or press <RET> to accept the default answer." G INV