- 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 Mar 13, 2025@20:53:27 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
