PSDREC.m

PSDREC ;BIR/LTL-CS Receiving ; 6 July 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 I '$D(PSDSITE) D ^PSDSET G:'$D(PSDSITE) QUIT

 I '$D(^XUSEC("PSJ RPHARM",DUZ)) W !!,"Sorry, you need the PSJ RPHARM Security key to do receiving.",!! G QUIT

 I $P($G(^VA(200,DUZ,20)),U,4)']"" N XQH S XQH="PSD ESIG" D EN^XQH G QUIT

SETUP D DT^DICRW N C,D,D0,DA,DIC,DINUM,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,DZ,PSDAT,PSDB,PSDI,PSDIT,PSDW,PSDLOC,PSDLOCN,PSDOUT,PSDP,PSDPI,PSDS,PSDCON,PSDL,PSDPO,PSDREC,PSDRUG,PSDRUGN,PSDT,PSAPV,X,Y,%,%H,%I S PSDL=0,(PSDI,PSDPO)=""

 D NOW^%DTC S PSDAT=+$E(%,1,12)

 S PSDLOC=$P(PSDSITE,U,3),PSDLOCN=$P(PSDSITE,U,4)

 G:$P(PSDSITE,U,5) CHKD

LOOK S DIC="^PSD(58.8,",DIC(0)="AEQ",DIC("A")="Select Dispensing Site: "

 S DIC("S")="I $P($G(^(0)),U,3)=+PSDSITE,$P($G(^(0)),U,2)[""M""&($S('$D(^(""I"")):1,+^(""I"")>DT:1,'^(""I""):1,1:0))"

 S:$P($G(^PSD(58.8,+PSDLOC,0)),U,2)["M" DIC("B")=PSDLOCN

 D ^DIC K DIC G:Y<0 QUIT S PSDLOC=+Y,PSDLOCN=$P(Y,U,2)

 S $P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=$P(Y,U,2)

CHKD D:$P($G(^PSD(58.8,PSDLOC,0)),U,8)=1  G:$D(DIRUT) QUIT

PV .W ! S DIR(0)="Y",DIR("A")="Is this a Prime Vendor receipt",DIR("B")="Yes",DIR("?")="If so, I'll retrieve the current Prime Vendor P.O.# for this Dispensing Site." D ^DIR K DIR Q:$D(DIRUT)!(Y<1)  S:Y=1 PSAPV=1

 .S (PSDPO,Y)=$P($G(^PSD(58.8,+PSDLOC,0)),U,9),C=$P(^DD(58.8,13,0),U,2)

 .D Y^DIQ S DIC("B")=Y

 .I +$E($P($G(^PRC(442,+PSDPO,12)),U,5),4,5)'=+$E(DT,4,5) W !!,"Current Prime Vendor P.O.#: ",Y,?40 S Y=$P($G(^(12)),U,5) X ^DD("DD") W "Date Assigned: ",Y

 I '$O(^PSD(58.8,PSDLOC,1,0)) W !!,"There are no drugs in ",PSDLOCN G QUIT

PO W ! S DIC="^PRC(442,",DIC(0)="AEMQZ" S:'$G(DIC("B")) DIC("B")=$G(PSDPO)

 S DIC("A")="Select Pharmacy Purchase Order Number: ",DIC("S")="I $P($G(^(0)),U,5)[822400" D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT)) QUIT S:Y>0 PSDPO=+Y I Y<1 S PSDPO(1)=0 G ^PSDREC2

 S PSDCON=$P($G(Y(0)),U,12)

 I $G(PSAPV),PSDPO'=$P($G(^PSD(58.8,+PSDLOC,0)),U,9) S DIE="^PSD(58.8,",DA=PSDLOC,DR="13////"_PSDPO D ^DIE K DIE,DA,DR

LINE I '$O(^PRC(442,+PSDPO,2,0)) W !!,"No line items on this P.O.",!! S PSDPO(1)=0 G ^PSDREC2

 I '$O(^PRC(442,+PSDPO,2,1)),'$P($G(^PRC(442,+PSDPO,2,1,0)),U,5) S PSDPO(1)=0 G ^PSDREC2

PART I '$O(^PRC(442,+PSDPO,11,0)) W !!,"No receipts processed for this P.O.",!! S PSDPO(1)=0 G ^PSDREC2

PRE I $O(^PSD(58.81,"C",PSDPO,"")) W !!,"Previous receipts have been processed for this P.O.",! S DIR(0)="Y",DIR("A")="Would you like to review them before proceeding",DIR("B")="Yes" D ^DIR K DIR G:$D(DIRUT) QUIT G:Y=1 DEV^PSDREV

CHO S DIR(0)="Y",DIR("A")="Loop through all items for a selected receipt",DIR("B")="Yes",DIR("?")="If not, I will ask you to select the item(s) to receive."

 S DIR("??")="^W !!,""If you plan on receiving only certain items, you may prefer NOT to loop."""

 W ! D ^DIR K DIR

 Q:$D(DIRUT)  G:'Y ^PSDREC3

 S PSDPI=$O(^PRC(442,+PSDPO,11,0)),PSDP=$P($G(^PRC(442,+PSDPO,11,+PSDPI,0)),U),Y=1 D:$O(^PRC(442,+PSDPO,11,PSDPI))

PSEL .S DIC="^PRC(442,+PSDPO,11,",DA(1)=PSDPO,DIC(0)="AEMQ",DIC("A")="Please select Warehouse receipt date: ",DIC("B")=$P($G(^PRC(442,+PSDPO,11,+$P($G(^PRC(442,+PSDPO,11,0)),U,3),0)),U),D="B",DZ="??" D DQ^DICQ

 .W ! D ^DIC K DIC S PSDPI=+Y,PSDP=$P(Y,U,2)

 D:Y>0 ^PSDREC1 S PSDPO="" G PO

QUIT Q

PSDREC    ;BIR/LTL-CS Receiving ; 6 July 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   GOTO QUIT

 +3        IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))

               WRITE !!,"Sorry, you need the PSJ RPHARM Security key to do receiving.",!!

               GOTO QUIT

 +4        IF $PIECE($GET(^VA(200,DUZ,20)),U,4)']""

               NEW XQH

               SET XQH="PSD ESIG"

               DO EN^XQH

               GOTO QUIT

SETUP      DO DT^DICRW

           NEW C,D,D0,DA,DIC,DINUM,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,DZ,PSDAT,PSDB,PSDI,PSDIT,PSDW,PSDLOC,PSDLOCN,PSDOUT,PSDP,PSDPI,PSDS,PSDCON,PSDL,PSDPO,PSDREC,PSDRUG,PSDRUGN,PSDT,PSAPV,X,Y,%,%H,%I

           SET PSDL=0

           SET (PSDI,PSDPO)=""

 +1        DO NOW^%DTC

           SET PSDAT=+$EXTRACT(%,1,12)

 +2        SET PSDLOC=$PIECE(PSDSITE,U,3)

           SET PSDLOCN=$PIECE(PSDSITE,U,4)

 +3        IF $PIECE(PSDSITE,U,5)

               GOTO CHKD

LOOK       SET DIC="^PSD(58.8,"

           SET DIC(0)="AEQ"

           SET DIC("A")="Select Dispensing Site: "

 +1        SET DIC("S")="I $P($G(^(0)),U,3)=+PSDSITE,$P($G(^(0)),U,2)[""M""&($S('$D(^(""I"")):1,+^(""I"")>DT:1,'^(""I""):1,1:0))"

 +2        IF $PIECE($GET(^PSD(58.8,+PSDLOC,0)),U,2)["M"

               SET DIC("B")=PSDLOCN

 +3        DO ^DIC

           KILL DIC

           IF Y<0

               GOTO QUIT

           SET PSDLOC=+Y

           SET PSDLOCN=$PIECE(Y,U,2)

 +4        SET $PIECE(PSDSITE,U,3)=+Y

           SET $PIECE(PSDSITE,U,4)=$PIECE(Y,U,2)

CHKD       IF $PIECE($GET(^PSD(58.8,PSDLOC,0)),U,8)=1

               Begin DoDot:1

PV                 WRITE !

                   SET DIR(0)="Y"

                   SET DIR("A")="Is this a Prime Vendor receipt"

                   SET DIR("B")="Yes"

                   SET DIR("?")="If so, I'll retrieve the current Prime Vendor P.O.# for this Dispensing Site."

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DIRUT)!(Y<1)

                       QUIT 

                   IF Y=1

                       SET PSAPV=1

 +1                SET (PSDPO,Y)=$PIECE($GET(^PSD(58.8,+PSDLOC,0)),U,9)

                   SET C=$PIECE(^DD(58.8,13,0),U,2)

 +2                DO Y^DIQ

                   SET DIC("B")=Y

 +3                IF +$EXTRACT($PIECE($GET(^PRC(442,+PSDPO,12)),U,5),4,5)'=+$EXTRACT(DT,4,5)

                       WRITE !!,"Current Prime Vendor P.O.#: ",Y,?40

                       SET Y=$PIECE($GET(^(12)),U,5)

                       XECUTE ^DD("DD")

                       WRITE "Date Assigned: ",Y

               End DoDot:1

           IF $DATA(DIRUT)

               GOTO QUIT

 +4        IF '$ORDER(^PSD(58.8,PSDLOC,1,0))

               WRITE !!,"There are no drugs in ",PSDLOCN

               GOTO QUIT

PO         WRITE !

           SET DIC="^PRC(442,"

           SET DIC(0)="AEMQZ"

           IF '$GET(DIC("B"))

               SET DIC("B")=$GET(PSDPO)

 +1        SET DIC("A")="Select Pharmacy Purchase Order Number: "

           SET DIC("S")="I $P($G(^(0)),U,5)[822400"

           DO ^DIC

           KILL DIC

           IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO QUIT

           IF Y>0

               SET PSDPO=+Y

           IF Y<1

               SET PSDPO(1)=0

               GOTO ^PSDREC2

 +2        SET PSDCON=$PIECE($GET(Y(0)),U,12)

 +3        IF $GET(PSAPV)

               IF PSDPO'=$PIECE($GET(^PSD(58.8,+PSDLOC,0)),U,9)

                   SET DIE="^PSD(58.8,"

                   SET DA=PSDLOC

                   SET DR="13////"_PSDPO

                   DO ^DIE

                   KILL DIE,DA,DR

LINE       IF '$ORDER(^PRC(442,+PSDPO,2,0))

               WRITE !!,"No line items on this P.O.",!!

               SET PSDPO(1)=0

               GOTO ^PSDREC2

 +1        IF '$ORDER(^PRC(442,+PSDPO,2,1))

               IF '$PIECE($GET(^PRC(442,+PSDPO,2,1,0)),U,5)

                   SET PSDPO(1)=0

                   GOTO ^PSDREC2

PART       IF '$ORDER(^PRC(442,+PSDPO,11,0))

               WRITE !!,"No receipts processed for this P.O.",!!

               SET PSDPO(1)=0

               GOTO ^PSDREC2

PRE        IF $ORDER(^PSD(58.81,"C",PSDPO,""))

               WRITE !!,"Previous receipts have been processed for this P.O.",!

               SET DIR(0)="Y"

               SET DIR("A")="Would you like to review them before proceeding"

               SET DIR("B")="Yes"

               DO ^DIR

               KILL DIR

               IF $DATA(DIRUT)

                   GOTO QUIT

               IF Y=1

                   GOTO DEV^PSDREV

CHO        SET DIR(0)="Y"

           SET DIR("A")="Loop through all items for a selected receipt"

           SET DIR("B")="Yes"

           SET DIR("?")="If not, I will ask you to select the item(s) to receive."

 +1        SET DIR("??")="^W !!,""If you plan on receiving only certain items, you may prefer NOT to loop."""

 +2        WRITE !

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

           IF 'Y

               GOTO ^PSDREC3

 +4        SET PSDPI=$ORDER(^PRC(442,+PSDPO,11,0))

           SET PSDP=$PIECE($GET(^PRC(442,+PSDPO,11,+PSDPI,0)),U)

           SET Y=1

           IF $ORDER(^PRC(442,+PSDPO,11,PSDPI))

               Begin DoDot:1

PSEL               SET DIC="^PRC(442,+PSDPO,11,"

                   SET DA(1)=PSDPO

                   SET DIC(0)="AEMQ"

                   SET DIC("A")="Please select Warehouse receipt date: "

                   SET DIC("B")=$PIECE($GET(^PRC(442,+PSDPO,11,+$PIECE($GET(^PRC(442,+PSDPO,11,0)),U,3),0)),U)

                   SET D="B"

                   SET DZ="??"

                   DO DQ^DICQ

 +1                WRITE !

                   DO ^DIC

                   KILL DIC

                   SET PSDPI=+Y

                   SET PSDP=$PIECE(Y,U,2)

               End DoDot:1

 +2        IF Y>0

               DO ^PSDREC1

           SET PSDPO=""

           GOTO PO

QUIT       QUIT