source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDORD1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PSDORD1 ;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
5AC 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
13SKIP 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
15SKIP2 S PSDD(1)=1 F S PSDD(2)=$P(PSDD,",",PSDD(1)) Q:'PSDD(2) S PSDD(1)=PSDD(1)+1 D
16ORD .;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
21END K DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PSD,PSDOUT,PSDB,PSDD,X,Y
22 Q
23PRT ;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
Note: See TracBrowser for help on using the repository browser.