PSDGSH2.m

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