PSGWFLBO.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSGWFLBO   1287     printed  Apr 09, 2024@20:45                                                                                                                                                                                                       Page 2

PSGWFLBO  ;BHAM ISC/MPH,CML-Enter/Edit Backorders ; 14 Feb 1989  1:49 PM

 +1       ;;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

 +1        IF '$PIECE(PSGWSITE,"^",5)

               IF ((PSGWOD-PSGWACT)>0)

                   WRITE !,"BACKORDERED ",PSGWOD-PSGWACT

DIC        IF '$DATA(PSGWDIN)

               SET DIC="^PSI(58.3,"

               SET DIC(0)="N"

               SET X=PSGWDN

               DO ^DIC

               KILL DIC

               if Y<0

                   QUIT 

               SET PSGWDIN=+Y

LOOP       SET PSGBOT=0

           SET DIE="^PSI(58.3,"

           SET DA=PSGWDIN

           SET DR="1///^S X=PSGWAOUN"

           FOR J=0:0

               SET J=$SELECT($DATA(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J)):$ORDER(^(J)),1:"")

               if J=""

                   QUIT 

               DO FILLBO

 +1        IF $PIECE(PSGWSITE,"^",5)

               GOTO END

NEWBO      SET PSGWOD=PSGWOD-PSGBOT

           IF PSGWACT<PSGWOD

               SET PSGBKO=PSGWOD-PSGWACT

               SET DR(2,58.31)="1///^S X=PSGWIN"

               SET DR(3,58.32)="1///^S X=PSGBKO;2///^S X=PSGBKO"

               DO ^DIE

END        KILL PSGWACT,PSGBKO,PSGBOT,PSGWDIN,PSGWDN,PSGWOD,PSGPIN,PSGQUAN,DIE,DR,DIC,X,DA,J

           QUIT 

 +1       ;

FILLBO     IF $PIECE(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",5)'=""

               if $PIECE(^(0),"^",5)<PSGWIN

                   GOTO BOTTOM

 +1        SET PSGQUAN=$PIECE(^PSI(58.3,PSGWDIN,1,PSGWDA,1,J,0),"^",2)

           SET PSGPIN=$PIECE(^(0),"^",1)

 +2        IF PSGWACT'<PSGQUAN

               SET PSGWACT=PSGWACT-PSGQUAN

               SET DR(3,58.32)="4///^S X=PSGWIN"

 +3       IF '$TEST

               SET PSGQUAN=PSGQUAN-PSGWACT

               SET DR(3,58.32)="1///^S X=PSGQUAN;3///TODAY;4///@"

DIE        SET DR(2,58.31)="1///^S X=PSGPIN"

           DO ^DIE

 +1        SET PSGBOT=PSGBOT+PSGQUAN

BOTTOM     QUIT