| [613] | 1 | PSGWFLBO ;BHAM ISC/MPH,CML-Enter/Edit Backorders ; 14 Feb 1989 1:49 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | 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
|
|---|
| 4 | I '$P(PSGWSITE,"^",5),((PSGWOD-PSGWACT)>0) W !,"BACKORDERED ",PSGWOD-PSGWACT
|
|---|
| 5 | DIC I '$D(PSGWDIN) S DIC="^PSI(58.3,",DIC(0)="N",X=PSGWDN D ^DIC K DIC Q:Y<0 S PSGWDIN=+Y
|
|---|
| 6 | 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
|
|---|
| 7 | I $P(PSGWSITE,"^",5) G END
|
|---|
| 8 | 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
|
|---|
| 9 | END K PSGWACT,PSGBKO,PSGBOT,PSGWDIN,PSGWDN,PSGWOD,PSGPIN,PSGQUAN,DIE,DR,DIC,X,DA,J Q
|
|---|
| 10 | ;
|
|---|
| 11 | FILLBO I $P(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",5)'="" G:$P(^(0),"^",5)<PSGWIN BOTTOM
|
|---|
| 12 | S PSGQUAN=$P(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",2),PSGPIN=$P(^(0),"^",1)
|
|---|
| 13 | I PSGWACT'<PSGQUAN S PSGWACT=PSGWACT-PSGQUAN,DR(3,58.32)="4///^S X=PSGWIN"
|
|---|
| 14 | E S PSGQUAN=PSGQUAN-PSGWACT,DR(3,58.32)="1///^S X=PSGQUAN;3///TODAY;4///@"
|
|---|
| 15 | DIE S DR(2,58.31)="1///^S X=PSGPIN" D ^DIE
|
|---|
| 16 | S PSGBOT=PSGBOT+PSGQUAN
|
|---|
| 17 | BOTTOM Q
|
|---|
