PSDRFZ ;BIR/JPW,LTL-Nurse RF Delayed Dispensing review; 8 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
;PAT=PATIENT,PSDR=DRUG
LOOP N PSD,PSDL S (PSDL,PSDA)=0
W !!,"Checking for any transactions since ",$$FMTE^XLFDT(PSDT,"1P")
S PSD=PSDT
CHEC F S PSD=$O(^PSD(58.81,"ACT",PSD)) Q:'PSD F S PSDL=$O(^PSD(58.81,"ACT",PSD,PSDL)) Q:'PSDL F S PSDA=$O(^PSD(58.81,"ACT",PSD,PSDL,PSDR,17,PSDA)) Q:'PSDA D
.W !!,"You may need to re-adjust the balance because of the following transaction(s)."
.S PSDA(2)=$$FMTE^XLFDT(PSD,"2P"),PSDA(3)=PSD
.W !!,PSDA(2),?20,$P($G(^PSD(58.81,PSDA,0)),U,6)," ",$S($P($G(^(0)),U,8)]"":$P($G(^(0)),U,8),1:$P($G(^PSDRUG(PSDR,660)),U,8))
.W:$P($G(^PSD(58.81,PSDA,9)),U,4) " (",$P($G(^(9)),U,4)," WASTED)"
.W:$P($G(^PSD(58.81,PSDA,3)),U,2) " (",$P($G(^(3)),U,2)," RETURNED)"
.W " ",$P($G(^VA(200,+$P($G(^PSD(58.81,PSDA,0)),U,7),0)),U)
.W:$P($G(^PSD(58.81,PSDA,0)),U,16)]"" !?25,$P($G(^(0)),U,16) S PSDA(4)=$P($G(^(0)),U,7)
.W:PSDL'=$G(NAOU) " {",$P($G(^PSD(58.8,PSDL,0)),U),"}"
.S PSDA(1)=PSDA
END Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDRFZ 1054 printed Dec 13, 2024@01:48:46 Page 2
PSDRFZ ;BIR/JPW,LTL-Nurse RF Delayed Dispensing review; 8 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
+2 ;PAT=PATIENT,PSDR=DRUG
LOOP NEW PSD,PSDL
SET (PSDL,PSDA)=0
+1 WRITE !!,"Checking for any transactions since ",$$FMTE^XLFDT(PSDT,"1P")
+2 SET PSD=PSDT
CHEC FOR
SET PSD=$ORDER(^PSD(58.81,"ACT",PSD))
if 'PSD
QUIT
FOR
SET PSDL=$ORDER(^PSD(58.81,"ACT",PSD,PSDL))
if 'PSDL
QUIT
FOR
SET PSDA=$ORDER(^PSD(58.81,"ACT",PSD,PSDL,PSDR,17,PSDA))
if 'PSDA
QUIT
Begin DoDot:1
+1 WRITE !!,"You may need to re-adjust the balance because of the following transaction(s)."
+2 SET PSDA(2)=$$FMTE^XLFDT(PSD,"2P")
SET PSDA(3)=PSD
+3 WRITE !!,PSDA(2),?20,$PIECE($GET(^PSD(58.81,PSDA,0)),U,6)," ",$SELECT($PIECE($GET(^(0)),U,8)]"":$PIECE($GET(^(0)),U,8),1:$PIECE($GET(^PSDRUG(PSDR,660)),U,8))
+4 if $PIECE($GET(^PSD(58.81,PSDA,9)),U,4)
WRITE " (",$PIECE($GET(^(9)),U,4)," WASTED)"
+5 if $PIECE($GET(^PSD(58.81,PSDA,3)),U,2)
WRITE " (",$PIECE($GET(^(3)),U,2)," RETURNED)"
+6 WRITE " ",$PIECE($GET(^VA(200,+$PIECE($GET(^PSD(58.81,PSDA,0)),U,7),0)),U)
+7 if $PIECE($GET(^PSD(58.81,PSDA,0)),U,16)]""
WRITE !?25,$PIECE($GET(^(0)),U,16)
SET PSDA(4)=$PIECE($GET(^(0)),U,7)
+8 if PSDL'=$GET(NAOU)
WRITE " {",$PIECE($GET(^PSD(58.8,PSDL,0)),U),"}"
+9 SET PSDA(1)=PSDA
End DoDot:1
END QUIT
