PSDGSH2 ;BIR/JPW-Review Green Sheet History (cont'd) ; 2 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
DISPLAY ;print data
S (PG,PSDOUT)=0 D HDR
W !,"Manufacturer",?16,": ",MFG,?61,"Lot:",?66,LOT,!,"Expiration Date : ",EXP
W !,"Dispensed by",?16,": ",$S($D(PSDBY):PSDBY,1:""),?49,"Disp Date: ",PSDDT
I $D(FILL),FILL]"" W !,"Filled by",?16,": ",FILL,?53,"Fill Date: ",$S($D(PROC):PROC,1:"")
W !,"Ord. Location",?16,": ",NAOU,!,"Ordered by",?16,": ",$G(REQ),?52
W "Order Date: ",$G(REQD)
I $D(PSDUZAN) W !,"Ord. by Pharm",?16,": ",PSDUZAN
S COMM=0
I $D(^PSD(58.81,PSDA,2,0)) S COMM=1 W !,"Comments:" K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.81,PSDA,2,TEXT)) Q:'TEXT S X=$G(^PSD(58.81,PSDA,2,TEXT,0)),DIWL=5,DIWR=75,DIWF="W" D ^DIWP
I COMM D ^DIWW S COMM=0
I $D(ORC),ORC]"" D CHK Q:PSDOUT W !,"Received by",?16,": ",ORC,?53,"Rec Date: ",$S($D(ORCD):ORCD,1:"")
I $D(RTECH),RTECH]"" D CHK Q:PSDOUT W !,"Rec'd by Tech",?16,": ",RTECH,?55,"Rec Date :",$S($D(ORCD):ORCD,1:"")
I $D(REAS),REAS]"" D CHK Q:PSDOUT W !,"REASON",?16,": ",REAS
I $D(PSDIN),PSDIN]"" D CHK Q:PSDOUT W !,"Insp Hold by:",?16,": ",PSDIN,?51,"Placed Date: ",PSDIP W:PSDIR]"" !,?50,"Removed Date: ",PSDIR
I NODE16]"" W !,"Hold Reason:",?16,": ",NODE16
I $D(RETN),RETN]"" D CHK Q:PSDOUT W !,"Comp by Nurse",?16,": ",RETN,?53,"Comp Date: ",PSDTP
I $D(PUBY),PUBY]"" D CHK Q:PSDOUT W !,"Pickup by",?16,": ",$S($D(PUBY):PUBY,1:""),?51,"Pickup Date: ",PUDT
I $D(CBY),CBY]"" D CHK Q:PSDOUT W !,"Completed by",?16,": ",CBY,?53,"Comp Date: ",$S($D(CDT):CDT,1:"")
I $D(OTR),OTR]"" D CHK Q:PSDOUT W !,"Referred Reason",?16,": ",OTR
I $D(NODE3)!($D(NODE4))!($D(NODE5))!($D(TRANS)) D MORE
W !
Q
HDR ;header
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
S PG=PG+1 W:$Y @IOF W !,?23,"Controlled Substance Order",!! K LN S $P(LN,"-",80)=""
W "Pharmacy Dispensing #: ",PSDPN,!,"Order Status",?21,": ",STAT,!,?23,$S(COMP]"":COMP,1:"")
W !,"Dispensing Location : ",PSDSN,!,LN,!
W:$P($G(^PSD(58.81,PSDA,9)),U) !,"Patient",?16,": ",$P($G(^DPT(+$P($G(^PSD(58.81,PSDA,9)),U),0)),U)
W !,"Drug",?16,": ",DRUG,?56,"Quantity: ",?66,QTY
Q
MORE ;additional display
I $D(NODE4),$D(EDT),EDT]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** EDITED AFTER VERIFICATION ***",!!,"Edit Date",?16,": ",EDT,?48,"New Adjusted Qty: ",?64,EDQTY,!,"Pharmacist",?16,": ",EDPH,!,"Reason",?16,": ",EREAS
I $D(NODE5),$D(CANCD),CANCD]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** CANCELLED AFTER VERIFICATION ***",!!,"Cancel Date",?16,": ",CANCD,!,"Pharmacist",?16,": ",CANCPH,!,"Reason",?16,": ",CREAS
I $D(NODE3),$D(STKD),STKD]"" D:$Y+8>IOSL HDR Q:PSDOUT W !!,?10,"*** RETURNED TO STOCK ***",!!,"Ret by Nurse",?16,": ",$S($D(RETN):RETN,1:""),?57,"Qty Ret: ",?66,STKQ,!,"Returned Date",?16,": ",STKD,!,"Reason",?16,": ",SREAS
I $D(NODE3),$D(DESTD),DESTD]"" D:$Y+10>IOSL HDR Q:PSDOUT W !!,?10,"*** TURNED IN FOR DESTRUCTION ***",!!,"Turned in by",?16,": ",$S($D(RETN):RETN,1:"") D
.W ?56,"Qty Dest:",?66,DESTQ,!,"Turn in Date",?16,": ",DESTD,!,"Holding #",?16,": ",DESTH,!,"Reason",?16,": ",DREAS
.W:DESDP]"" !,"Destroyed by",?16,": ",DESDP W:DESD]"" ?55,"Date Dest:",?66,DESD
I $D(NODE7) D:$Y+10>IOSL HDR Q:PSDOUT W !!,?10,"*** TRANSFER BETWEEN NAOUs ***",! D LOOP
W !
Q
LOOP ;loop thru transfer between naous
F JJ=0:0 S JJ=$O(TRN(JJ)) Q:'JJ D:$Y+8>IOSL HDR Q:PSDOUT W !,"From NAOU",?16,": ",$P(TRN(JJ),"^"),?56,"Quantity:",?66,$P(TRN(JJ),"^",7),!,"Nurse From",?16,": ",$P(TRN(JJ),"^",3),?56,"Date:",?62,$P(TRN(JJ),"^",2),! D
.W "To NAOU",?16,": ",$P(TRN(JJ),"^",4),!
.W "Nurse to",?16,": "
.W $S($P(TRN(JJ),"^",6)'=0:$P(TRN(JJ),U,6),1:"Not Received Yet"),?56
.W "Date:",?62,$S($P(TRN(JJ),"^",5)'=0:$P(TRN(JJ),"^",5),1:"*****")
Q
CHK ;check end of page
D:$Y+6>IOSL HDR
Q
PSDGSH2 ;BIR/JPW-Review Green Sheet History (cont'd) ; 2 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
DISPLAY ;print data
+1 SET (PG,PSDOUT)=0
DO HDR
+2 WRITE !,"Manufacturer",?16,": ",MFG,?61,"Lot:",?66,LOT,!,"Expiration Date : ",EXP
+3 WRITE !,"Dispensed by",?16,": ",$SELECT($DATA(PSDBY):PSDBY,1:""),?49,"Disp Date: ",PSDDT
+4 IF $DATA(FILL)
IF FILL]""
WRITE !,"Filled by",?16,": ",FILL,?53,"Fill Date: ",$SELECT($DATA(PROC):PROC,1:"")
+5 WRITE !,"Ord. Location",?16,": ",NAOU,!,"Ordered by",?16,": ",$GET(REQ),?52
+6 WRITE "Order Date: ",$GET(REQD)
+7 IF $DATA(PSDUZAN)
WRITE !,"Ord. by Pharm",?16,": ",PSDUZAN
+8 SET COMM=0
+9 IF $DATA(^PSD(58.81,PSDA,2,0))
SET COMM=1
WRITE !,"Comments:"
KILL ^UTILITY($JOB,"W")
FOR TEXT=0:0
SET TEXT=$ORDER(^PSD(58.81,PSDA,2,TEXT))
IF 'TEXT
QUIT
SET X=$GET(^PSD(58.81,PSDA,2,TEXT,0))
SET DIWL=5
SET DIWR=75
SET DIWF="W"
DO ^DIWP
+10 IF COMM
DO ^DIWW
SET COMM=0
+11 IF $DATA(ORC)
IF ORC]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Received by",?16,": ",ORC,?53,"Rec Date: ",$SELECT($DATA(ORCD):ORCD,1:"")
+12 IF $DATA(RTECH)
IF RTECH]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Rec'd by Tech",?16,": ",RTECH,?55,"Rec Date :",$SELECT($DATA(ORCD):ORCD,1:"")
+13 IF $DATA(REAS)
IF REAS]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"REASON",?16,": ",REAS
+14 IF $DATA(PSDIN)
IF PSDIN]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Insp Hold by:",?16,": ",PSDIN,?51,"Placed Date: ",PSDIP
IF PSDIR]""
WRITE !,?50,"Removed Date: ",PSDIR
+15 IF NODE16]""
WRITE !,"Hold Reason:",?16,": ",NODE16
+16 IF $DATA(RETN)
IF RETN]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Comp by Nurse",?16,": ",RETN,?53,"Comp Date: ",PSDTP
+17 IF $DATA(PUBY)
IF PUBY]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Pickup by",?16,": ",$SELECT($DATA(PUBY):PUBY,1:""),?51,"Pickup Date: ",PUDT
+18 IF $DATA(CBY)
IF CBY]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Completed by",?16,": ",CBY,?53,"Comp Date: ",$SELECT($DATA(CDT):CDT,1:"")
+19 IF $DATA(OTR)
IF OTR]""
DO CHK
IF PSDOUT
QUIT
WRITE !,"Referred Reason",?16,": ",OTR
+20 IF $DATA(NODE3)!($DATA(NODE4))!($DATA(NODE5))!($DATA(TRANS))
DO MORE
+21 WRITE !
+22 QUIT
HDR ;header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
WRITE !
KILL DA,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 SET PG=PG+1
IF $Y
WRITE @IOF
WRITE !,?23,"Controlled Substance Order",!!
KILL LN
SET $PIECE(LN,"-",80)=""
+3 WRITE "Pharmacy Dispensing #: ",PSDPN,!,"Order Status",?21,": ",STAT,!,?23,$SELECT(COMP]"":COMP,1:"")
+4 WRITE !,"Dispensing Location : ",PSDSN,!,LN,!
+5 IF $PIECE($GET(^PSD(58.81,PSDA,9)),U)
WRITE !,"Patient",?16,": ",$PIECE($GET(^DPT(+$PIECE($GET(^PSD(58.81,PSDA,9)),U),0)),U)
+6 WRITE !,"Drug",?16,": ",DRUG,?56,"Quantity: ",?66,QTY
+7 QUIT
MORE ;additional display
+1 IF $DATA(NODE4)
IF $DATA(EDT)
IF EDT]""
IF $Y+8>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !!,?10,"*** EDITED AFTER VERIFICATION ***",!!,"Edit Date",?16,": ",EDT,?48,"New Adjusted Qty: ",?64,EDQTY,!,"Pharmacist",?16,": ",EDPH,!,"Reason",?16,": ",EREAS
+2 IF $DATA(NODE5)
IF $DATA(CANCD)
IF CANCD]""
IF $Y+8>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !!,?10,"*** CANCELLED AFTER VERIFICATION ***",!!,"Cancel Date",?16,": ",CANCD,!,"Pharmacist",?16,": ",CANCPH,!,"Reason",?16,": ",CREAS
+3 IF $DATA(NODE3)
IF $DATA(STKD)
IF STKD]""
IF $Y+8>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !!,?10,"*** RETURNED TO STOCK ***",!!,"Ret by Nurse",?16,": ",$SELECT($DATA(RETN):RETN,1:""),?57,"Qty Ret: ",?66,STKQ,!,"Returned Date",?16,": ",STKD,!,"Reason",?16,": ",SREAS
+4 IF $DATA(NODE3)
IF $DATA(DESTD)
IF DESTD]""
IF $Y+10>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !!,?10,"*** TURNED IN FOR DESTRUCTION ***",!!,"Turned in by",?16,": ",$SELECT($DATA(RETN):RETN,1:"")
Begin DoDot:1
+5 WRITE ?56,"Qty Dest:",?66,DESTQ,!,"Turn in Date",?16,": ",DESTD,!,"Holding #",?16,": ",DESTH,!,"Reason",?16,": ",DREAS
+6 IF DESDP]""
WRITE !,"Destroyed by",?16,": ",DESDP
IF DESD]""
WRITE ?55,"Date Dest:",?66,DESD
End DoDot:1
+7 IF $DATA(NODE7)
IF $Y+10>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !!,?10,"*** TRANSFER BETWEEN NAOUs ***",!
DO LOOP
+8 WRITE !
+9 QUIT
LOOP ;loop thru transfer between naous
+1 FOR JJ=0:0
SET JJ=$ORDER(TRN(JJ))
IF 'JJ
QUIT
IF $Y+8>IOSL
DO HDR
IF PSDOUT
QUIT
WRITE !,"From NAOU",?16,": ",$PIECE(TRN(JJ),"^"),?56,"Quantity:",?66,$PIECE(TRN(JJ),"^",7),!,"Nurse From",?16,": ",$PIECE(TRN(JJ),"^",3),?56,"Date:",?62,$PIECE(TRN(JJ),"^",2),!
Begin DoDot:1
+2 WRITE "To NAOU",?16,": ",$PIECE(TRN(JJ),"^",4),!
+3 WRITE "Nurse to",?16,": "
+4 WRITE $SELECT($PIECE(TRN(JJ),"^",6)'=0:$PIECE(TRN(JJ),U,6),1:"Not Received Yet"),?56
+5 WRITE "Date:",?62,$SELECT($PIECE(TRN(JJ),"^",5)'=0:$PIECE(TRN(JJ),"^",5),1:"*****")
End DoDot:1
+6 QUIT
CHK ;check end of page
+1 IF $Y+6>IOSL
DO HDR
+2 QUIT
