| [613] | 1 | PSDPDR2 ;BIR/BJW-Narc Disp/Rec Report (VA FORM 10-2321) (cont'd) ; 09 FEB 95
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | PRINT ;entry to print
|
|---|
| 4 | S COPY=$S(PSDCPY="V":2,1:1) D COPY
|
|---|
| 5 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 6 | I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
|
|---|
| 7 | END K %,%H,%I,%ZIS,ALL,ANS,C,CNT,COPY,COMM,DA,DIC,DIE,DIR,DIROUT,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,DUOUT,EXP,EXPD,FLAG,LN,LOOP,LOT,MFG,NAOU,NODE,NUM
|
|---|
| 8 | K OK,ORD,ORDN,PG,POP,PSD,PSDA,PSDCPY,PSDDT,PSDEV,PSDG,PSDIO,PSDN,PSDNA,PSDOUT,PSDPT,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDSN,PSDST,QTY,REQD,REQDT,RPDT,SEL,STAT,STATN,TEXT,X,Y
|
|---|
| 9 | K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 10 | K ^TMP("PSDRPT",$J) D ^%ZISC
|
|---|
| 11 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 12 | Q
|
|---|
| 13 | HDR ;header for log
|
|---|
| 14 | ;;The next line inserted for E3R# 3311 2-9-95.
|
|---|
| 15 | I PG,$G(PSDCPY)="V"!($G(COPY)=2) W !,"* VERIFIED ORDER WAS EDITED."
|
|---|
| 16 | I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 17 | S PG=PG+1 W:$Y @IOF I PSDCPY="V"!(COPY=2) W !,?45,"*** RECEIPT VERIFICATION COPY ***",!,?42,"Technician Delivering Orders: ________________________",!
|
|---|
| 18 | W !,?2,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report" I NAOU]"",NAOU'=0 W " for ",NAOU W:$P($G(^PSD(58.8,+$O(^PSD(58.8,"B",NAOU,0)),2)),U,5) " (Perpetual Inventory)"
|
|---|
| 19 | W ?125,"Page: ",PG,!,?52,RPDT,!
|
|---|
| 20 | W !,?14,"DATE",?78,"DATE"
|
|---|
| 21 | W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"
|
|---|
| 22 | W !,LN,!!
|
|---|
| 23 | Q
|
|---|
| 24 | COPY ;copy 1 and 2
|
|---|
| 25 | S (COMM,PG,PSDOUT,NAOU)=0 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
|
|---|
| 26 | K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDRPT",$J)) D HDR W !!,?45,"**** NO PENDING NARCOTIC ORDERS TO BE DELIVERED ****" S FLAG=1 Q
|
|---|
| 27 | S NAOU="" F S NAOU=$O(^TMP("PSDRPT",$J,NAOU)) Q:NAOU=""!(PSDOUT) D HDR Q:PSDOUT D Q:PSDOUT I PSDCPY="B",COPY=1 S COPY=2 D HDR D S COPY=1
|
|---|
| 28 | .;;$Y changed to 12 to force fnote to print at bottom of page E3R# 3311.
|
|---|
| 29 | .S NUM="" F S NUM=$O(^TMP("PSDRPT",$J,NAOU,NUM)) Q:NUM=""!(PSDOUT) D:$Y+12>IOSL HDR Q:PSDOUT S NODE=^TMP("PSDRPT",$J,NAOU,NUM) D
|
|---|
| 30 | COP ..I $P(NODE,"^",9),$Y+12>IOSL D HDR Q:PSDOUT
|
|---|
| 31 | ..;;The next line inserted for E3r# 3311 2-9-95.
|
|---|
| 32 | ..NEW X S X=$P(NODE,"^",2) S X=$S(PSDCPY="V":X,COPY=2:X,1:+X)
|
|---|
| 33 | ..W !,NUM,?12,$P(NODE,"^",3),?21,$J(X,6),?33,$P(NODE,"^"),?78,$P(NODE,"^",4),?90,$P(NODE,"^",5)
|
|---|
| 34 | ..;;Balance inserted for E3R# 3311 2-9-95.
|
|---|
| 35 | ..I PSDCPY="V"!(COPY=2) W !,?33,"BALANCE: "_$S($P(NODE,"^",11)]"":+$P(NODE,"^",11),1:"UNKNOWN")_" "_$P(NODE,"^",12)
|
|---|
| 36 | ..I $P(NODE,"^",6)]"" W !,?33,"Mfg/Lot #/Exp Date: ",$P(NODE,"^",6)_" "_$P(NODE,"^",7)_" "_$P(NODE,"^",8)
|
|---|
| 37 | ..W !!,?7,"Disp by RPh:___________________________________",?61,"Rec'd by Nurse:___________________________________",!,?19,"(Full Name)",?76,"(Full Name)",!
|
|---|
| 38 | ..I $P(NODE,"^",9) W ?24,"COMMENTS:" S COMM=1,PSDA=$P(NODE,"^",10) K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.81,PSDA,2,TEXT)) Q:'TEXT D:$Y+4>IOSL HDR Q:PSDOUT S X=$G(^PSD(58.81,PSDA,2,TEXT,0)),DIWL=34,DIWR=115,DIWF="W" D ^DIWP
|
|---|
| 39 | ..I COMM D ^DIWW S COMM=0 W !
|
|---|
| 40 | ..K DA,DIE,DR S (DA,PSDA)=+$P(NODE,"^",10),DR="102////"_PSDPT,DIE=58.81 D ^DIE K DA,DIE,DR
|
|---|
| 41 | ;;The next line inserted for E3R# 3311 2-9-95.
|
|---|
| 42 | I PG,$G(PSDCPY)="V"!($G(COPY)=2) W !,"* VERIFIED ORDER WAS EDITED."
|
|---|
| 43 | Q
|
|---|
