- PSDRDR2 ;BIR/BJW-Narc Disp/Rec (reprint VA FORM 10-2321) (cont'd) ; 4 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- PRINT ;reprint log in lieu of VA FORM 10-2321
- S COPY=1 D COPY Q:PSDOUT G:$D(FLAG) DONE
- I PSDCPY="B" S COPY=2 D COPY
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
- END Q
- HDR ;header for log
- I PG,$G(PSDCPY)="V"!($G(COPY)=2) W !,"* VERIFIED ORDER WAS EDITED."
- 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 !,?55,"*** REPRINT ***",! I PSDCPY="V"!(COPY=2) W !,?50,"*** PHARMACY VAULT COPY ***",!,?42,"Technician Delivering Orders: ____________________",!
- W !,?2,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report" I NAOU]"",NAOU'=0 W " for ",NAOU
- W ?120,"Page: ",PG,!,?52,RPDT,!
- W !,?14,"DATE",?78,"DATE"
- W !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"
- W !,LN,!!
- Q
- COPY ;copy number
- S (COMM,PG,PSDOUT,NAOU)=0 D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
- K LN S $P(LN,"-",132)="" I '$D(^TMP("PSDRDR",$J)) D HDR W !!,?45,"**** NO PENDING NARCOTIC ORDERS TO BE DELIVERED ****" S FLAG=1 Q
- S NAOU="" F S NAOU=$O(^TMP("PSDRDR",$J,NAOU)) Q:NAOU=""!(PSDOUT) D HDR Q:PSDOUT D Q:PSDOUT
- .S NUM="" F S NUM=$O(^TMP("PSDRDR",$J,NAOU,NUM)) Q:NUM=""!(PSDOUT) D:$Y+12>IOSL HDR Q:PSDOUT S NODE=^TMP("PSDRDR",$J,NAOU,NUM) D
- ..I $P(NODE,"^",9),$Y+12>IOSL D HDR Q:PSDOUT
- ..NEW X S X=$P(NODE,"^",2) S X=$S(PSDCPY="V":X,COPY=2:X,1:+X)
- ..W !,NUM,?12,$P(NODE,"^",3),?21,$J(X,6),?33,$P(NODE,"^"),?78,$P(NODE,"^",4),?90,$P(NODE,"^",5)
- ..;;The next line added for E3R# 3311 2-9-95.
- ..I PSDCPY="V"!(COPY=2) W !,?33,"BALANCE: "_$S(+$P(NODE,"^",13):+$P(NODE,"^",13),1:"UNKNOWN")_" "_$P(NODE,"^",14)
- ..I $P(NODE,"^",6)]"" W !,?33,"Mfg/Lot #/Exp Date: ",$P(NODE,"^",6)_" "_$P(NODE,"^",7)_" "_$P(NODE,"^",8)
- ..W !!,?7,"Disp by RPh:",$S($P(NODE,"^",11)]"":" "_$P(NODE,"^",11),1:"___________________________________")
- ..W ?61,"Rec'd by Nurse:",$S($P(NODE,"^",12)]"":" "_$P(NODE,"^",12),1:"___________________________________")
- ..W !,?19,"(Full Name)",?76,"(Full Name)",!
- ..I $P(NODE,"^",9) W ?24,"COMMENTS:" S COMM=1,PSDA=$P(NODE,"^",10) K ^UTILITY($J,"W") F TEXT=0:0 S TEXT=$O(^PSD(58.81,PSDA,2,TEXT)) Q:'TEXT D:$Y+4>IOSL HDR Q:PSDOUT S X=$G(^PSD(58.81,PSDA,2,TEXT,0)),DIWL=34,DIWR=115,DIWF="W" D ^DIWP
- ..I COMM D ^DIWW S COMM=0 W !
- I PG,$G(PSDCPY)="V"!($G(COPY)=2) W !,"* VERIFIED ORDER WAS EDITED."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDRDR2 2575 printed Feb 18, 2025@23:14:46 Page 2
- PSDRDR2 ;BIR/BJW-Narc Disp/Rec (reprint VA FORM 10-2321) (cont'd) ; 4 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- PRINT ;reprint log in lieu of VA FORM 10-2321
- +1 SET COPY=1
- DO COPY
- if PSDOUT
- QUIT
- if $DATA(FLAG)
- GOTO DONE
- +2 IF PSDCPY="B"
- SET COPY=2
- DO COPY
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF 'PSDOUT
- WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
- DO ^DIR
- KILL DIR
- END QUIT
- HDR ;header for log
- +1 IF PG
- IF $GET(PSDCPY)="V"!($GET(COPY)=2)
- WRITE !,"* VERIFIED ORDER WAS EDITED."
- +2 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
- +3 SET PG=PG+1
- if $Y
- WRITE @IOF
- WRITE !,?55,"*** REPRINT ***",!
- IF PSDCPY="V"!(COPY=2)
- WRITE !,?50,"*** PHARMACY VAULT COPY ***",!,?42,"Technician Delivering Orders: ____________________",!
- +4 WRITE !,?2,"VA FORM 10-2321",?42,"Narcotic Dispensing/Receiving Report"
- IF NAOU]""
- IF NAOU'=0
- WRITE " for ",NAOU
- +5 WRITE ?120,"Page: ",PG,!,?52,RPDT,!
- +6 WRITE !,?14,"DATE",?78,"DATE"
- +7 WRITE !,"DISP #",?12,"DISPENSED",?24,"QTY",?33,"DRUG",?78,"ORD",?90,"ORDERED BY"
- +8 WRITE !,LN,!!
- +9 QUIT
- COPY ;copy number
- +1 SET (COMM,PG,PSDOUT,NAOU)=0
- DO NOW^%DTC
- SET Y=+$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET RPDT=Y
- +2 KILL LN
- SET $PIECE(LN,"-",132)=""
- IF '$DATA(^TMP("PSDRDR",$JOB))
- DO HDR
- WRITE !!,?45,"**** NO PENDING NARCOTIC ORDERS TO BE DELIVERED ****"
- SET FLAG=1
- QUIT
- +3 SET NAOU=""
- FOR
- SET NAOU=$ORDER(^TMP("PSDRDR",$JOB,NAOU))
- if NAOU=""!(PSDOUT)
- QUIT
- DO HDR
- if PSDOUT
- QUIT
- Begin DoDot:1
- +4 SET NUM=""
- FOR
- SET NUM=$ORDER(^TMP("PSDRDR",$JOB,NAOU,NUM))
- if NUM=""!(PSDOUT)
- QUIT
- if $Y+12>IOSL
- DO HDR
- if PSDOUT
- QUIT
- SET NODE=^TMP("PSDRDR",$JOB,NAOU,NUM)
- Begin DoDot:2
- +5 IF $PIECE(NODE,"^",9)
- IF $Y+12>IOSL
- DO HDR
- if PSDOUT
- QUIT
- +6 NEW X
- SET X=$PIECE(NODE,"^",2)
- SET X=$SELECT(PSDCPY="V":X,COPY=2:X,1:+X)
- +7 WRITE !,NUM,?12,$PIECE(NODE,"^",3),?21,$JUSTIFY(X,6),?33,$PIECE(NODE,"^"),?78,$PIECE(NODE,"^",4),?90,$PIECE(NODE,"^",5)
- +8 ;;The next line added for E3R# 3311 2-9-95.
- +9 IF PSDCPY="V"!(COPY=2)
- WRITE !,?33,"BALANCE: "_$SELECT(+$PIECE(NODE,"^",13):+$PIECE(NODE,"^",13),1:"UNKNOWN")_" "_$PIECE(NODE,"^",14)
- +10 IF $PIECE(NODE,"^",6)]""
- WRITE !,?33,"Mfg/Lot #/Exp Date: ",$PIECE(NODE,"^",6)_" "_$PIECE(NODE,"^",7)_" "_$PIECE(NODE,"^",8)
- +11 WRITE !!,?7,"Disp by RPh:",$SELECT($PIECE(NODE,"^",11)]"":" "_$PIECE(NODE,"^",11),1:"___________________________________")
- +12 WRITE ?61,"Rec'd by Nurse:",$SELECT($PIECE(NODE,"^",12)]"":" "_$PIECE(NODE,"^",12),1:"___________________________________")
- +13 WRITE !,?19,"(Full Name)",?76,"(Full Name)",!
- +14 IF $PIECE(NODE,"^",9)
- WRITE ?24,"COMMENTS:"
- SET COMM=1
- SET PSDA=$PIECE(NODE,"^",10)
- KILL ^UTILITY($JOB,"W")
- FOR TEXT=0:0
- SET TEXT=$ORDER(^PSD(58.81,PSDA,2,TEXT))
- if 'TEXT
- QUIT
- if $Y+4>IOSL
- DO HDR
- if PSDOUT
- QUIT
- SET X=$GET(^PSD(58.81,PSDA,2,TEXT,0))
- SET DIWL=34
- SET DIWR=115
- SET DIWF="W"
- DO ^DIWP
- +15 IF COMM
- DO ^DIWW
- SET COMM=0
- WRITE !
- End DoDot:2
- End DoDot:1
- if PSDOUT
- QUIT
- +16 IF PG
- IF $GET(PSDCPY)="V"!($GET(COPY)=2)
- WRITE !,"* VERIFIED ORDER WAS EDITED."
- +17 QUIT
