| [613] | 1 | PSDORP1 ;BIR/JPW-Pharm CS Order Entry (cont'd) ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|---|
| 3 | ;MULTIPLE ORDERS
|
|---|
| 4 | I $D(ORD) F CNT1=1:1:CNT S PSDA=+ORD(CNT1) S:$G(PSDR(2))&(CNT1=1) PSDQTY=PSDR(2) D ASK
|
|---|
| 5 | Q
|
|---|
| 6 | ASK ;displays order for review
|
|---|
| 7 | D DISPLAY
|
|---|
| 8 | W !! K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this OK",DIR("?",1)="Answer 'YES' to send this request to pharmacy for processing,"
|
|---|
| 9 | S DIR("?",2)="or 'NO' to edit or delete this request",DIR("?")="or '^' to quit and DELETE this CS order request." D ^DIR K DIR
|
|---|
| 10 | I $D(DIRUT) S PSDOUT=1 D DEL Q
|
|---|
| 11 | I 'Y D EDIT Q:PSDOUT G ASK
|
|---|
| 12 | I Y N X,X1 D SIG^XUSESIG S:X1="" PSDOUT=1 D:X1="" DEL Q:X1="" D PHARM W !! W:$D(ORD) "Your order request #"_CNT1_" of "_CNT W ?32,"Sent to Pharmacy...",!! R:$D(ORD) "Press <RET> to continue",X:DTIME,!!
|
|---|
| 13 | Q
|
|---|
| 14 | DISPLAY ;displays order request to screen
|
|---|
| 15 | K LN S $P(LN,"-",80)=""
|
|---|
| 16 | W @IOF,!,?23,"Controlled Substance Order Request" I $D(ORD) W " # "_CNT1_" of "_CNT
|
|---|
| 17 | W !!,"Pharmacy Dispensing #: ",!,"Requested by",?16,": ",$P($G(^VA(200,PSDUZ,0)),"^"),?52,"Request Date: ",REQD,!,LN,!
|
|---|
| 18 | W !,"Drug",?16,": ",PSDRN,?56,"Quantity: ",?66,PSDQTY,!,"Dispensed by",?16,": N/A",?50,"Dispensed Date: N/A"
|
|---|
| 19 | W !,"Disp. Location",?16,": " W:+PSDS $P($G(^PSD(58.8,+PSDS,0)),"^") W !,"Exp. Date",?16,": ",!,"Manufacturer",?16,": ",!,"Lot #",?16,": "
|
|---|
| 20 | W !,"Ord. Location",?16,": ",NAOUN,!,"Order Status",?16,": ",$P($G(^PSD(58.82,1,0)),"^"),!,"Comments:"
|
|---|
| 21 | I $D(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0)) K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT)) Q:'TEXT D
|
|---|
| 22 | .S X=$G(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP
|
|---|
| 23 | I D ^DIWW
|
|---|
| 24 | Q
|
|---|
| 25 | EDIT ;edit or delete order request
|
|---|
| 26 | W !!,"Edit or Delete this Order Request: EDIT// " R X:DTIME I '$T S PSDOUT=1 D DEL Q
|
|---|
| 27 | Q:X["^" S X=$E(X) S:X="" X="E" I "EeDd"'[X W !!,"Press <RET> to edit this order request, or enter 'D' to delete the request.",! G EDIT
|
|---|
| 28 | I "Dd"[X D DEL Q
|
|---|
| 29 | K DA,DIE,DR S DA=PSDA,DA(1)=PSDR,DA(2)=NAOU,DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DR="3;13" D ^DIE K DIE,DR
|
|---|
| 30 | Q
|
|---|
| 31 | DEL ;deletes order request
|
|---|
| 32 | S PSDOUT=1 W !!,?25,"Request being deleted...",! K DIK S DA=PSDA,DA(1)=PSDR,DA(2)=NAOU,DIK="^PSD(58.8,"_NAOU_",1,"_PSDR_",3," D ^DIK K DIK
|
|---|
| 33 | Q
|
|---|
| 34 | PHARM ;create worksheet entry in file 58.85
|
|---|
| 35 | W ?5,!!,"Processing your request now..." F L +^PSD(58.85,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 36 | ADD S PSDREC=$P(^PSD(58.85,0),"^",3)+1 I $D(^PSD(58.85,PSDREC)) S $P(^PSD(58.85,0),"^",3)=PSDREC G ADD
|
|---|
| 37 | K DA,DIC,DIE,DR,DLAYGO S (DIC,DIE,DLAYGO)=58.85,DIC(0)="L",X=PSDREC D ^DIC K DIC,DLAYGO
|
|---|
| 38 | L -^PSD(58.85,0)
|
|---|
| 39 | S PSDRD=$S($P($G(^PSD(58.8,NAOU,1,PSDR,3,PSDA,0)),"^",2):$P(^(0),"^",2),1:DT)
|
|---|
| 40 | S DA=PSDREC,DR="1////"_PSDS_";2////"_NAOU_";3////"_PSDR_";4////"_PSDA_";5////"_PSDQTY_";6////1;12////"_PSDUZA_";19////"_PSDRD_";20////"_PSDUZ D ^DIE K DIE
|
|---|
| 41 | I $D(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0)) S ^PSD(58.85,PSDREC,1,0)=^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,0) D
|
|---|
| 42 | .F WORD=0:0 S WORD=$O(^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,WORD)) Q:'WORD S ^PSD(58.85,PSDREC,1,WORD,0)=^PSD(58.8,NAOU,1,PSDR,3,PSDA,1,WORD,0)
|
|---|
| 43 | K DA,DIC,DIE,DLAYGO,DR,PSDREC,WORD S PSDQTY=$S($G(PSDR(1)):PSDR(1),1:NPKG)
|
|---|
| 44 | Q
|
|---|
