36 lines
2.0 KiB
Mathematica
36 lines
2.0 KiB
Mathematica
PSDORD1 ;BIR/LTL-CS Order Entry Listing and Cancel pending; 19 Dec 94
|
|
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|
D PRT S PSDC="D" F PSD=1:1:$G(PSD(2)) S PSDD=$G(PSDD)_PSD_","
|
|
G:$G(PSDOUT) SKIP2
|
|
AC S DIR(0)="SA^A:Approve;D:Delete"
|
|
S DIR("A")="Approve or Delete (A/D): "
|
|
S DIR("?")="After selecting an action, you may select a range of orders."
|
|
S DIR("B")="Approve" D ^DIR K DIR N PSDC S PSDC=Y
|
|
G:$D(DIRUT) SKIP2
|
|
I $G(PSD(2))=1 S PSDD="1," G SKIP
|
|
S DIR(0)="L^1:"_$G(PSD(2)) W ! D ^DIR K DIR I $D(DIRUT) S PSDC="D" G SKIP2
|
|
S PSDD=Y
|
|
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
|
|
N X,X1 D SIG^XUSESIG I X1="" S PSDC="D" G SKIP
|
|
SKIP2 S PSDD(1)=1 F S PSDD(2)=$P(PSDD,",",PSDD(1)) Q:'PSDD(2) S PSDD(1)=PSDD(1)+1 D
|
|
ORD .;update ord
|
|
.S PSDR=+$O(PSDB(PSDD(2),0)),PSDA=+$O(PSDB(PSDD(2),PSDR,0))
|
|
.S PSDQTY=$P($G(^PSD(58.8,+NAOU,1,+PSDR,3,+PSDA,0)),U,6)
|
|
.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
|
|
.D DEL^PSDORD2 K PSDA(PSDR,PSDA) S PSDOUT=0
|
|
END K DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSD,PSDOUT,PSDB,PSDD,X,Y
|
|
Q
|
|
PRT ;displays list
|
|
W @IOF,"Accessing pending requests for ",$P($G(^VA(200,DUZ,.1)),U,4),"...",!
|
|
K ^UTILITY($J,"W")
|
|
N X,DIWL,DIWR,DIWF S PSD=0,DIWL=1,DIWR=80,DIWF="W"
|
|
F S PSD=$O(^PSD(58.8,+PSDS,5,PSD)) Q:'PSD S X=$G(^PSD(58.8,+PSDS,5,PSD,0)) D ^DIWP
|
|
D ^DIWW
|
|
W !,"The following request(s) may be approved or deleted:",!
|
|
W !,"# DATE ORDERED",?20,"DRUG",?72,"QUANTITY",!! S PSD=0
|
|
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)
|
|
.S Y=$E($P(PSDA(PSD,PSD(1)),U,2),1,7) X ^DD("DD") W !,PSD(2),?3,Y,?16
|
|
.W $P($G(^PSDRUG(PSD,0)),U),?72,$J($P(PSDA(PSD,PSD(1)),U,6),4)
|
|
.I $Y+2>IOSL S DIR(0)="E" D ^DIR K DIR S:Y<1 PSDOUT=1 W @IOF
|
|
Q
|