| [613] | 1 | PSDORD1 ;BIR/LTL-CS Order Entry Listing and Cancel pending; 19 Dec 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | D PRT S PSDC="D" F PSD=1:1:$G(PSD(2)) S PSDD=$G(PSDD)_PSD_","
|
|---|
| 4 | G:$G(PSDOUT) SKIP2
|
|---|
| 5 | AC S DIR(0)="SA^A:Approve;D:Delete"
|
|---|
| 6 | S DIR("A")="Approve or Delete (A/D): "
|
|---|
| 7 | S DIR("?")="After selecting an action, you may select a range of orders."
|
|---|
| 8 | S DIR("B")="Approve" D ^DIR K DIR N PSDC S PSDC=Y
|
|---|
| 9 | G:$D(DIRUT) SKIP2
|
|---|
| 10 | I $G(PSD(2))=1 S PSDD="1," G SKIP
|
|---|
| 11 | S DIR(0)="L^1:"_$G(PSD(2)) W ! D ^DIR K DIR I $D(DIRUT) S PSDC="D" G SKIP2
|
|---|
| 12 | S PSDD=Y
|
|---|
| 13 | SKIP I PSDC="D" S DIR(0)="Y",DIR("B")="No",DIR("A")="Are you sure you want to cancel request(s) #"_$E(PSDD,1,($L(PSDD)-1)) W ! D ^DIR K DIR G:$D(DIRUT) SKIP2 G:'Y AC G SKIP2
|
|---|
| 14 | N X,X1 D SIG^XUSESIG I X1="" S PSDC="D" G SKIP
|
|---|
| 15 | SKIP2 S PSDD(1)=1 F S PSDD(2)=$P(PSDD,",",PSDD(1)) Q:'PSDD(2) S PSDD(1)=PSDD(1)+1 D
|
|---|
| 16 | ORD .;update ord
|
|---|
| 17 | .S PSDR=+$O(PSDB(PSDD(2),0)),PSDA=+$O(PSDB(PSDD(2),PSDR,0))
|
|---|
| 18 | .S PSDQTY=$P($G(^PSD(58.8,+NAOU,1,+PSDR,3,+PSDA,0)),U,6)
|
|---|
| 19 | .I PSDC="A" D NOW^%DTC S PSDT=+$E(%,1,12),DIE="^PSD(58.8,+NAOU,1,+PSDR,3,",DA(2)=NAOU,DA(1)=PSDR,DA=PSDA,DR="1////"_PSDT_";10////1" D ^DIE K DIE,DA,DR D PHARM^PSDORD2 K PSDA(PSDR,PSDA) Q
|
|---|
| 20 | .D DEL^PSDORD2 K PSDA(PSDR,PSDA) S PSDOUT=0
|
|---|
| 21 | END K DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSD,PSDOUT,PSDB,PSDD,X,Y
|
|---|
| 22 | Q
|
|---|
| 23 | PRT ;displays list
|
|---|
| 24 | W @IOF,"Accessing pending requests for ",$P($G(^VA(200,DUZ,.1)),U,4),"...",!
|
|---|
| 25 | K ^UTILITY($J,"W")
|
|---|
| 26 | N X,DIWL,DIWR,DIWF S PSD=0,DIWL=1,DIWR=80,DIWF="W"
|
|---|
| 27 | F S PSD=$O(^PSD(58.8,+PSDS,5,PSD)) Q:'PSD S X=$G(^PSD(58.8,+PSDS,5,PSD,0)) D ^DIWP
|
|---|
| 28 | D ^DIWW
|
|---|
| 29 | W !,"The following request(s) may be approved or deleted:",!
|
|---|
| 30 | W !,"# DATE ORDERED",?20,"DRUG",?72,"QUANTITY",!! S PSD=0
|
|---|
| 31 | F S PSD=$O(PSDA(PSD)) Q:'PSD!($G(PSDOUT)) S PSD(1)=0 F S PSD(1)=$O(PSDA(PSD,PSD(1))) Q:'PSD(1) S PSD(2)=$G(PSD(2))+1,PSDB(PSD(2),PSD,PSD(1))="" D Q:$G(PSDOUT)
|
|---|
| 32 | .S Y=$E($P(PSDA(PSD,PSD(1)),U,2),1,7) X ^DD("DD") W !,PSD(2),?3,Y,?16
|
|---|
| 33 | .W $P($G(^PSDRUG(PSD,0)),U),?72,$J($P(PSDA(PSD,PSD(1)),U,6),4)
|
|---|
| 34 | .I $Y+2>IOSL S DIR(0)="E" D ^DIR K DIR S:Y<1 PSDOUT=1 W @IOF
|
|---|
| 35 | Q
|
|---|
