PSGWFLBO ;BHAM ISC/MPH,CML-Enter/Edit Backorders ; 14 Feb 1989  1:49 PM
 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
CMT ;PSGWOD-TO BE DISPENSED AMT, PSGWACT-ACTUAL DISP.,PSGWDIN=DA OF 58.3,PSGWDA-AOU NUMBER,PSGWIN-DATE OF BKORD,PSGWAOUN-AOU NAME,SET IN ROUTINE CALLING PSGFLBO
 I '$P(PSGWSITE,"^",5),((PSGWOD-PSGWACT)>0) W !,"BACKORDERED ",PSGWOD-PSGWACT
DIC I '$D(PSGWDIN) S DIC="^PSI(58.3,",DIC(0)="N",X=PSGWDN D ^DIC K DIC Q:Y<0  S PSGWDIN=+Y
LOOP S PSGBOT=0,DIE="^PSI(58.3,",DA=PSGWDIN,DR="1///^S X=PSGWAOUN" F J=0:0 S J=$S($D(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J)):$O(^(J)),1:"") Q:J=""  D FILLBO
 I $P(PSGWSITE,"^",5) G END
NEWBO S PSGWOD=PSGWOD-PSGBOT I PSGWACT<PSGWOD S PSGBKO=PSGWOD-PSGWACT,DR(2,58.31)="1///^S X=PSGWIN",DR(3,58.32)="1///^S X=PSGBKO;2///^S X=PSGBKO" D ^DIE
END K PSGWACT,PSGBKO,PSGBOT,PSGWDIN,PSGWDN,PSGWOD,PSGPIN,PSGQUAN,DIE,DR,DIC,X,DA,J Q
 ;
FILLBO I $P(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",5)'="" G:$P(^(0),"^",5)<PSGWIN BOTTOM
 S PSGQUAN=$P(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",2),PSGPIN=$P(^(0),"^",1)
 I PSGWACT'<PSGQUAN S PSGWACT=PSGWACT-PSGQUAN,DR(3,58.32)="4///^S X=PSGWIN"
 E  S PSGQUAN=PSGQUAN-PSGWACT,DR(3,58.32)="1///^S X=PSGQUAN;3///TODAY;4///@"
DIE S DR(2,58.31)="1///^S X=PSGPIN" D ^DIE
 S PSGBOT=PSGBOT+PSGQUAN
BOTTOM Q