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

PSGWBO ;BHAM ISC/MPH,CML-Enter/Edit Actual Dispensed/Backorder Values ; 09 Dec 93 / 3:10 PM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
 I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE)  S PSGWFLG=1
 I '$D(PSGWIDA) 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,X1=DT,X2=$P($P(Y,"^",2),".") D ^%DTC
 I '$D(^PSI(58.19,"AINV",PSGWIDA)) W !!,$S(X<101:"INVENTORY SHEET MUST BE PRINTED BEFORE ON-HAND AMOUNTS MAY BE ENTERED",1:"INVENTORY OVER 100 DAYS OLD CANNOT BE EDITED") G END
 ;
EN1 ; PSGWIDA = DA of inventory being edited
 K PSGW("PO") S PSGWV="AMIS COMPILE FLAG"
 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)=""
 S (PSGWADT,PSGWIN)=$P(^PSI(58.19,PSGWIDA,0),"^",1),PSGWCAT="A",FLG=0,AMISFL=0
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)) D:'PSGDA RESET Q:'PSGDA  D WENT Q:FLG  S AMISFL=0
END W ! K PSGW("PO"),DLAYGO,I,J,K,K1,PSG1,PSG2,PSG3,PSGWACT,PSGWAOUN,PSGWDA,PSGDDA,PSGWDIN,PSGWDN,PSGDR,PSGWOD,PSGSORTK,PSGWIN,PSGWN,PSGX,PSGDA,PSGTYP,PSGWIDA,SK,X,Y,A,PSGWADT,PSGWCAT,PSGWQD,FLG,AMISFL,PSGWAOU,KEY,PSGWV,DA,%,%Y,LP,PC
 K TPSG1,TPSG2,TPSG3,TEMPDR,TYP,DIC,DIE,DR K:$D(PSGWFLG) PSGWFLG,PSGWSITE
 Q
WENT S PSGWN=$S($D(^PSI(58.1,PSGDA,0)):$P(^(0),"^",1),1:""),DIC("B")=PSGWN,DIC("A")="Select AREA OF USE: ",DIC("S")="I $D(^PSI(58.19,PSGWIDA,1,""B"",+Y,+Y))"
 W ! S DIC="^PSI(58.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
 S PSG1=""
PSG1 S PSG1=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1)) Q:PSG1=""  S PSG2=""
PSG2 S PSG2=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2)) G PSG1:PSG2="" S PSG3=""
PSG3 S PSG3=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3)) G PSG2:PSG3="" S PSGTYP=""
PSGTYP S PSGTYP=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP)) G PSG3:PSGTYP="" S PSGDR=""
PSGDR S PSGDR=$O(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR)) G PSGTYP:PSGDR=""
 I $P(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",4)'="",$P(^(PSGDR),"^",4)'>-1 G PSGDR
 S PSGDDA=+^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),PSGWDN=$P(^(PSGDR),"^",2)
 S TEMPDR=PSGDR W !!,"ITEM: ",PSGDR
 I '$D(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0)) G PSGDR
 S A=^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0) S (PSGX(5),PSGWOD)=$P(A,"^",5)
DIS W !,"DISPENSE QUANTITY: " W:PSGX(5)'="" PSGX(5),"// " R X:DTIME S:'$T FLG=1 Q:'$T  G:X="" EXP Q:X="^"  I X["^" D GETVAL^PSGWBO1 G:DA<0 DIS G PSGDR
 I "?"[$E(X)!(X<0)!(X>9999)!(X'?1N.N) W *7,!,"Enter number between 0 and 9999 which is the quantity dispensed." G DIS
 I X D CHKQTY^PSGWBO1 I $D(QTYFLG) K QTYFLG W !!,"ITEM: ",PSGDR G DIS
 S PSGX(5)=$S(X="@":"",1:X),$P(^PSI(58.1,PSGWDA,1,PSGDDA,1,PSGWIDA,0),"^",5)=PSGX(5),PSGWACT=PSGX(5)
 S PSGWQD=PSGX(5)-PSGWOD I (AMISFL=1)&(PSGWQD'=0) S ^PSI(58.5,"AMIS",$H,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)=""
 S ^(PSGDR)=$P(^PSI(58.19,"AINV",PSGWIDA,PSGWDA,PSG1,PSG2,PSG3,PSGTYP,PSGDR),"^",1,3)_"^"_PSGX(5)
 I $P(PSGWSITE,"^",5) S DIC(0)=""
 E  S DIC(0)="QL",DLAYGO="^PSI(58.3,"
 S DIC="^PSI(58.3,",X="`"_PSGWDN D ^DIC I Y'<0 S PSGWDIN=+Y D ^PSGWFLBO
 ;
EXP I $P(^PSI(58.1,PSGWDA,0),"^",4) S DA(1)=PSGWDA,DA=PSGDDA,DIE="^PSI(58.1,"_DA(1)_",1,",DR=35 D ^DIE K DIE,DIC
 G PSGDR
RESET ; Reset Sort key if AOUs taken out of order
 I $O(PSGW("PO",PSGSORTK,0))'=PSGWAOU F J=0:0 S J=$O(PSGW("PO",J)) Q:'J  I $O(PSGW("PO",J,0))=PSGWAOU S PSGSORTK=J Q
 Q