PSDORSU ;BIR/JPW,LTL-Nurse Order Stats Report ; 8 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
W !!,"You are about to adjust the balance upward.",!!
W "Before you do, let's check to see if there are any orders that need receiving."
N AOU,STAT,ORD S STAT=3
S:'$G(NAOU) NAOU=PSDLOC
S AOU=NAOU,ORD=0
S:$G(PSDRUG) PSDR=PSDRUG
ORD ;order loop
S:'$D(^XUSEC("PSJ RNURSE",DUZ))&('$D(^XUSEC("PSD NURSE",DUZ))) STAT(1)=1
F S ORD=$O(^PSD(58.8,"AC",STAT,NAOU,PSDR,ORD)) Q:'ORD D Q:$D(DIRUT)!($G(PSDOUT))
.S ORD(1)=$G(^PSD(58.8,NAOU,1,PSDR,3,ORD,0)),PSDA=$P(ORD(1),U,17)
.W !!,"Pharmacy Dispensing #: ",$P(ORD(1),U,16)
.W " Date/time ordered: ",$$FMTE^XLFDT($P(ORD(1),U,2),"2P")
.W " Quantity: ",$P(ORD(1),U,6)
.Q:$G(STAT(1))
.S DIR(0)="Y",DIR("A")="Receive now" W ! D ^DIR K DIR
.S:$D(DIRUT) PSDOUT=1 Q:Y'=1
.S Y(0)=$G(^PSD(58.81,+PSDA,0)) D ORD^PSDNRGO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDORSU 890 printed Nov 22, 2024@16:57:59 Page 2
PSDORSU ;BIR/JPW,LTL-Nurse Order Stats Report ; 8 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
+2 WRITE !!,"You are about to adjust the balance upward.",!!
+3 WRITE "Before you do, let's check to see if there are any orders that need receiving."
+4 NEW AOU,STAT,ORD
SET STAT=3
+5 if '$GET(NAOU)
SET NAOU=PSDLOC
+6 SET AOU=NAOU
SET ORD=0
+7 if $GET(PSDRUG)
SET PSDR=PSDRUG
ORD ;order loop
+1 if '$DATA(^XUSEC("PSJ RNURSE",DUZ))&('$DATA(^XUSEC("PSD NURSE",DUZ)))
SET STAT(1)=1
+2 FOR
SET ORD=$ORDER(^PSD(58.8,"AC",STAT,NAOU,PSDR,ORD))
if 'ORD
QUIT
Begin DoDot:1
+3 SET ORD(1)=$GET(^PSD(58.8,NAOU,1,PSDR,3,ORD,0))
SET PSDA=$PIECE(ORD(1),U,17)
+4 WRITE !!,"Pharmacy Dispensing #: ",$PIECE(ORD(1),U,16)
+5 WRITE " Date/time ordered: ",$$FMTE^XLFDT($PIECE(ORD(1),U,2),"2P")
+6 WRITE " Quantity: ",$PIECE(ORD(1),U,6)
+7 if $GET(STAT(1))
QUIT
+8 SET DIR(0)="Y"
SET DIR("A")="Receive now"
WRITE !
DO ^DIR
KILL DIR
+9 if $DATA(DIRUT)
SET PSDOUT=1
if Y'=1
QUIT
+10 SET Y(0)=$GET(^PSD(58.81,+PSDA,0))
DO ORD^PSDNRGO
End DoDot:1
if $DATA(DIRUT)!($GET(PSDOUT))
QUIT
+11 QUIT
