- PSDRFV ;BIR/JPW,LTL-Nurse RF Dispensing review; 8 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;**5,12,25,27**;13 Feb 97
- ;Reference to ^PSD(58.8 are covered by DBIA #2711
- ;Reference to ^PSD(58.81 are covered by DBIA #2808
- ;Reference to ^PSDRUG( are covered by DBIA #221
- ; Reference to VA(200 DBIA # 10060
- ;
- ;PAT=PATIENT,PSDR=DRUG
- LOOP N PSD,PSDL S (PSDL,PSDA,PSDT)=0
- W !!,"Doses signed out in the last ",$S($G(NAOU(1)):NAOU(1),1:"eight")," hours:"
- S PSDT=$$FMADD^XLFDT($$NOW^XLFDT,0,-$S($G(NAOU(1)):NAOU(1),1:8))
- CHEC ;PSD*3*27 (DAVE B - Do not need to look at every ward - PSDL)
- S PSDL=$G(NAOU)
- F S PSDT=$O(^PSD(58.81,"ACT",PSDT)) Q:'PSDT F S PSDA=$O(^PSD(58.81,"ACT",PSDT,PSDL,PSDR,17,PSDA)) Q:'PSDA D:$P($G(^PSD(58.81,PSDA,9)),U)=$G(PAT)
- .S PSDA(2)=$$FMTE^XLFDT(PSDT,"2P"),PSDA(3)=PSDT
- .W !!,PSDA(2),?22,$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)
- .S PSDA(1)=PSDA
- END Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDRFV 1257 printed Jan 18, 2025@02:49:57 Page 2
- PSDRFV ;BIR/JPW,LTL-Nurse RF Dispensing review; 8 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**5,12,25,27**;13 Feb 97
- +2 ;Reference to ^PSD(58.8 are covered by DBIA #2711
- +3 ;Reference to ^PSD(58.81 are covered by DBIA #2808
- +4 ;Reference to ^PSDRUG( are covered by DBIA #221
- +5 ; Reference to VA(200 DBIA # 10060
- +6 ;
- +7 ;PAT=PATIENT,PSDR=DRUG
- LOOP NEW PSD,PSDL
- SET (PSDL,PSDA,PSDT)=0
- +1 WRITE !!,"Doses signed out in the last ",$SELECT($GET(NAOU(1)):NAOU(1),1:"eight")," hours:"
- +2 SET PSDT=$$FMADD^XLFDT($$NOW^XLFDT,0,-$SELECT($GET(NAOU(1)):NAOU(1),1:8))
- CHEC ;PSD*3*27 (DAVE B - Do not need to look at every ward - PSDL)
- +1 SET PSDL=$GET(NAOU)
- +2 FOR
- SET PSDT=$ORDER(^PSD(58.81,"ACT",PSDT))
- if 'PSDT
- QUIT
- FOR
- SET PSDA=$ORDER(^PSD(58.81,"ACT",PSDT,PSDL,PSDR,17,PSDA))
- if 'PSDA
- QUIT
- if $PIECE($GET(^PSD(58.81,PSDA,9)),U)=$GET(PAT)
- Begin DoDot:1
- +3 SET PSDA(2)=$$FMTE^XLFDT(PSDT,"2P")
- SET PSDA(3)=PSDT
- +4 WRITE !!,PSDA(2),?22,$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))
- +5 if $PIECE($GET(^PSD(58.81,PSDA,9)),U,4)
- WRITE " (",$PIECE($GET(^(9)),U,4)," WASTED)"
- +6 if $PIECE($GET(^PSD(58.81,PSDA,3)),U,2)
- WRITE " (",$PIECE($GET(^(3)),U,2)," RETURNED)"
- +7 WRITE " ",$PIECE($GET(^VA(200,+$PIECE($GET(^PSD(58.81,PSDA,0)),U,7),0)),U)
- +8 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)
- +9 SET PSDA(1)=PSDA
- End DoDot:1
- END QUIT