| 1 | PSDREC ;BIR/LTL-CS Receiving ; 6 July 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | I '$D(PSDSITE) D ^PSDSET G:'$D(PSDSITE) QUIT
|
|---|
| 4 | I '$D(^XUSEC("PSJ RPHARM",DUZ)) W !!,"Sorry, you need the PSJ RPHARM Security key to do receiving.",!! G QUIT
|
|---|
| 5 | I $P($G(^VA(200,DUZ,20)),U,4)']"" N XQH S XQH="PSD ESIG" D EN^XQH G QUIT
|
|---|
| 6 | 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)=""
|
|---|
| 7 | D NOW^%DTC S PSDAT=+$E(%,1,12)
|
|---|
| 8 | S PSDLOC=$P(PSDSITE,U,3),PSDLOCN=$P(PSDSITE,U,4)
|
|---|
| 9 | G:$P(PSDSITE,U,5) CHKD
|
|---|
| 10 | LOOK S DIC="^PSD(58.8,",DIC(0)="AEQ",DIC("A")="Select Dispensing Site: "
|
|---|
| 11 | 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))"
|
|---|
| 12 | S:$P($G(^PSD(58.8,+PSDLOC,0)),U,2)["M" DIC("B")=PSDLOCN
|
|---|
| 13 | D ^DIC K DIC G:Y<0 QUIT S PSDLOC=+Y,PSDLOCN=$P(Y,U,2)
|
|---|
| 14 | S $P(PSDSITE,U,3)=+Y,$P(PSDSITE,U,4)=$P(Y,U,2)
|
|---|
| 15 | CHKD D:$P($G(^PSD(58.8,PSDLOC,0)),U,8)=1 G:$D(DIRUT) QUIT
|
|---|
| 16 | 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
|
|---|
| 17 | .S (PSDPO,Y)=$P($G(^PSD(58.8,+PSDLOC,0)),U,9),C=$P(^DD(58.8,13,0),U,2)
|
|---|
| 18 | .D Y^DIQ S DIC("B")=Y
|
|---|
| 19 | .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
|
|---|
| 20 | I '$O(^PSD(58.8,PSDLOC,1,0)) W !!,"There are no drugs in ",PSDLOCN G QUIT
|
|---|
| 21 | PO W ! S DIC="^PRC(442,",DIC(0)="AEMQZ" S:'$G(DIC("B")) DIC("B")=$G(PSDPO)
|
|---|
| 22 | 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
|
|---|
| 23 | S PSDCON=$P($G(Y(0)),U,12)
|
|---|
| 24 | 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
|
|---|
| 25 | LINE I '$O(^PRC(442,+PSDPO,2,0)) W !!,"No line items on this P.O.",!! S PSDPO(1)=0 G ^PSDREC2
|
|---|
| 26 | I '$O(^PRC(442,+PSDPO,2,1)),'$P($G(^PRC(442,+PSDPO,2,1,0)),U,5) S PSDPO(1)=0 G ^PSDREC2
|
|---|
| 27 | PART I '$O(^PRC(442,+PSDPO,11,0)) W !!,"No receipts processed for this P.O.",!! S PSDPO(1)=0 G ^PSDREC2
|
|---|
| 28 | 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
|
|---|
| 29 | 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."
|
|---|
| 30 | S DIR("??")="^W !!,""If you plan on receiving only certain items, you may prefer NOT to loop."""
|
|---|
| 31 | W ! D ^DIR K DIR
|
|---|
| 32 | Q:$D(DIRUT) G:'Y ^PSDREC3
|
|---|
| 33 | 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))
|
|---|
| 34 | 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
|
|---|
| 35 | .W ! D ^DIC K DIC S PSDPI=+Y,PSDP=$P(Y,U,2)
|
|---|
| 36 | D:Y>0 ^PSDREC1 S PSDPO="" G PO
|
|---|
| 37 | QUIT Q
|
|---|
