- PSDNU1 ;BIR/JPW-Print NAOU Usage Report by Drug ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry point for report
- K ^TMP("PSDNU",$J),^TMP("PSDNUS",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQT",$J),^TMP("PSDNUQ",$J)
- I $D(ALL) D ALL G PRINT
- F JJ2=2,3,4,5 F PSDR=0:0 S PSDR=$O(LOC(PSDR)) Q:'PSDR F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 D
- .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK D SET
- PRINT ;prints data for stock drugs
- I SUM D ^PSDNU3 G DONE
- K LN S $P(LN,"-",80)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
- I '$D(^TMP("PSDNU",$J)) D HDR W !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
- S PSDR="" F S PSDR=$O(^TMP("PSDNU",$J,PSDR)) D:PSDR="" GTOT Q:PSDR=""!(PSDOUT) D HDR S NAOU="" F S NAOU=$O(^TMP("PSDNU",$J,PSDR,NAOU)) D:NAOU="" NTOT Q:NAOU=""!(PSDOUT) W !,?2,"=> ",NAOU,!! D
- .S NUM="" F S NUM=$O(^TMP("PSDNU",$J,PSDR,NAOU,NUM)) D:NUM="" TOT Q:NUM=""!(PSDOUT) F JJ=0:0 S JJ=$O(^TMP("PSDNU",$J,PSDR,NAOU,NUM,JJ)) Q:'JJ!(PSDOUT) D
- ..S NODE=^TMP("PSDNU",$J,PSDR,NAOU,NUM,JJ),DATE=$E(JJ,4,5)_"/"_$E(JJ,6,7)_"/"_$E(JJ,2,3)
- ..I $Y+8>IOSL D HDR Q:PSDOUT W !,?2,"=> ",NAOU,!!
- ..W NUM,?16,DATE,?25,$J($P(NODE,"^"),6),?37,$P(NODE,"^",2),?70,$P(NODE,"^",3),!
- 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 ;
- K %,%DT,%H,%I,%ZIS,ALL,ANS,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IO("Q"),JJ,JJ1,JJ2,KK,LOC,LN
- K NAOU,NAOUN,NODE,NUM,NURS,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDSD,PSDT,PSDTR,RPDT,SUM,X,Y
- K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- K ^TMP("PSDNU",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQ",$J),^TMP("PSDNUS",$J),^TMP("PSDNUQT",$J)
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ALL ;loops for all drugs
- Q:'$D(ALL)
- F JJ2=2,3,4,5 F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR)) Q:'PSDR D
- .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK D SET
- Q
- HDR ;lists header information
- I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- W:$Y @IOF S PG=PG+1 W !,"DRUG/NAOU USAGE REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
- I $D(PSDR),PSDR]"" W "DRUG: ",PSDR,!
- W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
- W !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?72,"TYPE",!,LN,!
- Q
- TOT Q:PSDOUT W !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$J,PSDR,NAOU),?25,$J(^TMP("PSDNUQ",$J,PSDR,NAOU),6),?37,"Totals",!
- Q
- NTOT Q:PSDOUT W !,"DRUG Subtotal # of Orders: ",^TMP("PSDNUT",$J,PSDR)," Total Quantity: ",^TMP("PSDNUQT",$J,PSDR),!
- Q
- GTOT ;grand total
- Q:PSDOUT
- W !,"Grand Total # of Orders: ",^TMP("PSDNUG",$J),!
- Q
- SET ;sets data
- Q:'$D(^PSD(58.81,KK,0)) S NODE=^PSD(58.81,KK,0),PSD=+$P(NODE,"^",18)
- Q:$P($G(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE S PSDOK=0
- S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
- S NAOUN=$S($P($G(^PSD(58.8,PSD,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
- S PSDPN=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"DISP W/O GS"),QTY=+$P(NODE,"^",6)
- S:+$P($G(^PSD(58.81,KK,4)),"^",3) QTY=+$P($G(^(4)),"^",3)
- I JJ2=2,$D(^PSD(58.81,KK,7)),+$P($G(^(7)),"^",3)'=PSD S QTY=QTY-(+$P(^(7),"^",7))
- S QTY=$S(JJ2=3:-(+$P($G(^PSD(58.81,KK,3)),"^",2)),JJ2=4:-(+$P($G(^PSD(58.81,KK,3)),"^",5)),JJ2=14:+$P($G(^PSD(58.81,KK,4)),"^",3),1:QTY)
- I JJ2=5 S PSDTR=+$P($G(^PSD(58.81,KK,7)),"^",6) D:PSDTR
- .I +$P($G(^PSD(58.81,PSDTR,0)),"^",18)=PSD S PSDOK=1
- S NURS=$S(+$P($G(^PSD(58.81,KK,1)),"^",7):+$P($G(^(1)),"^",7),1:+$P($G(^PSD(58.81,KK,1)),"^",3))
- S NURS=$S($P($G(^VA(200,NURS,0)),"^")]"":$P(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
- S ^TMP("PSDNU",$J,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_NURS_"^"_$S(JJ2=2:"DISPENSE",JJ2=3:"RET/STK",JJ2=4:"DESTROY",JJ2=5:"TRANSFER",1:"N/A")
- S:'$D(^TMP("PSDNUT",$J,PSDRN)) ^TMP("PSDNUT",$J,PSDRN)=0 S:'PSDOK ^TMP("PSDNUT",$J,PSDRN)=+^TMP("PSDNUT",$J,PSDRN)+1
- S:'$D(^TMP("PSDNUQT",$J,PSDRN)) ^TMP("PSDNUQT",$J,PSDRN)=0 S ^TMP("PSDNUQT",$J,PSDRN)=+^TMP("PSDNUQT",$J,PSDRN)+QTY
- S:'$D(^TMP("PSDNUS",$J,PSDRN,NAOUN)) ^TMP("PSDNUS",$J,PSDRN,NAOUN)=0 S:'PSDOK ^TMP("PSDNUS",$J,PSDRN,NAOUN)=+^TMP("PSDNUS",$J,PSDRN,NAOUN)+1
- S:'$D(^TMP("PSDNUQ",$J,PSDRN,NAOUN)) ^TMP("PSDNUQ",$J,PSDRN,NAOUN)=0 S ^TMP("PSDNUQ",$J,PSDRN,NAOUN)=+^TMP("PSDNUQ",$J,PSDRN,NAOUN)+QTY
- S:'$D(^TMP("PSDNUG",$J)) ^TMP("PSDNUG",$J)=0 S:'PSDOK ^TMP("PSDNUG",$J)=+^TMP("PSDNUG",$J)+1
- S PSDOK=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNU1 4713 printed Mar 13, 2025@20:51:53 Page 2
- PSDNU1 ;BIR/JPW-Print NAOU Usage Report by Drug ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry point for report
- +1 KILL ^TMP("PSDNU",$JOB),^TMP("PSDNUS",$JOB),^TMP("PSDNUT",$JOB),^TMP("PSDNUG",$JOB),^TMP("PSDNUQT",$JOB),^TMP("PSDNUQ",$JOB)
- +2 IF $DATA(ALL)
- DO ALL
- GOTO PRINT
- +3 FOR JJ2=2,3,4,5
- FOR PSDR=0:0
- SET PSDR=$ORDER(LOC(PSDR))
- if 'PSDR
- QUIT
- FOR JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
- if 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
- if 'JJ1
- QUIT
- Begin DoDot:1
- +4 FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK))
- if 'KK
- QUIT
- DO SET
- End DoDot:1
- PRINT ;prints data for stock drugs
- +1 IF SUM
- DO ^PSDNU3
- GOTO DONE
- +2 KILL LN
- SET $PIECE(LN,"-",80)=""
- SET (PG,PSDOUT)=0
- SET %DT=""
- SET X="T"
- DO ^%DT
- XECUTE ^DD("DD")
- SET RPDT=Y
- +3 IF '$DATA(^TMP("PSDNU",$JOB))
- DO HDR
- WRITE !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****"
- GOTO DONE
- +4 SET PSDR=""
- FOR
- SET PSDR=$ORDER(^TMP("PSDNU",$JOB,PSDR))
- if PSDR=""
- DO GTOT
- if PSDR=""!(PSDOUT)
- QUIT
- DO HDR
- SET NAOU=""
- FOR
- SET NAOU=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU))
- if NAOU=""
- DO NTOT
- if NAOU=""!(PSDOUT)
- QUIT
- WRITE !,?2,"=> ",NAOU,!!
- Begin DoDot:1
- +5 SET NUM=""
- FOR
- SET NUM=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU,NUM))
- if NUM=""
- DO TOT
- if NUM=""!(PSDOUT)
- QUIT
- FOR JJ=0:0
- SET JJ=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU,NUM,JJ))
- if 'JJ!(PSDOUT)
- QUIT
- Begin DoDot:2
- +6 SET NODE=^TMP("PSDNU",$JOB,PSDR,NAOU,NUM,JJ)
- SET DATE=$EXTRACT(JJ,4,5)_"/"_$EXTRACT(JJ,6,7)_"/"_$EXTRACT(JJ,2,3)
- +7 IF $Y+8>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !,?2,"=> ",NAOU,!!
- +8 WRITE NUM,?16,DATE,?25,$JUSTIFY($PIECE(NODE,"^"),6),?37,$PIECE(NODE,"^",2),?70,$PIECE(NODE,"^",3),!
- End DoDot:2
- End DoDot:1
- 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 ;
- +1 KILL %,%DT,%H,%I,%ZIS,ALL,ANS,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IO("Q"),JJ,JJ1,JJ2,KK,LOC,LN
- +2 KILL NAOU,NAOUN,NODE,NUM,NURS,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDSD,PSDT,PSDTR,RPDT,SUM,X,Y
- +3 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +4 KILL ^TMP("PSDNU",$JOB),^TMP("PSDNUT",$JOB),^TMP("PSDNUG",$JOB),^TMP("PSDNUQ",$JOB),^TMP("PSDNUS",$JOB),^TMP("PSDNUQT",$JOB)
- +5 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 QUIT
- ALL ;loops for all drugs
- +1 if '$DATA(ALL)
- QUIT
- +2 FOR JJ2=2,3,4,5
- FOR JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
- if 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
- if 'JJ1
- QUIT
- FOR PSDR=0:0
- SET PSDR=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR))
- if 'PSDR
- QUIT
- Begin DoDot:1
- +3 FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK))
- if 'KK
- QUIT
- DO SET
- End DoDot:1
- +4 QUIT
- HDR ;lists header information
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 if $Y
- WRITE @IOF
- SET PG=PG+1
- WRITE !,"DRUG/NAOU USAGE REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
- +3 IF $DATA(PSDR)
- IF PSDR]""
- WRITE "DRUG: ",PSDR,!
- +4 WRITE "From ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!
- +5 WRITE !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?72,"TYPE",!,LN,!
- +6 QUIT
- TOT if PSDOUT
- QUIT
- WRITE !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$JOB,PSDR,NAOU),?25,$JUSTIFY(^TMP("PSDNUQ",$JOB,PSDR,NAOU),6),?37,"Totals",!
- +1 QUIT
- NTOT if PSDOUT
- QUIT
- WRITE !,"DRUG Subtotal # of Orders: ",^TMP("PSDNUT",$JOB,PSDR)," Total Quantity: ",^TMP("PSDNUQT",$JOB,PSDR),!
- +1 QUIT
- GTOT ;grand total
- +1 if PSDOUT
- QUIT
- +2 WRITE !,"Grand Total # of Orders: ",^TMP("PSDNUG",$JOB),!
- +3 QUIT
- SET ;sets data
- +1 if '$DATA(^PSD(58.81,KK,0))
- QUIT
- SET NODE=^PSD(58.81,KK,0)
- SET PSD=+$PIECE(NODE,"^",18)
- +2 if $PIECE($GET(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE
- QUIT
- SET PSDOK=0
- +3 SET PSDRN=$SELECT($PIECE($GET(^PSDRUG(PSDR,0)),"^")]"":$PIECE(^(0),"^"),1:"DRUG NAME MISSING")
- +4 SET NAOUN=$SELECT($PIECE($GET(^PSD(58.8,PSD,0)),"^")]"":$PIECE(^(0),"^"),1:"NAOU NAME MISSING")
- +5 SET PSDPN=$SELECT($PIECE(NODE,"^",17)]"":$PIECE(NODE,"^",17),1:"DISP W/O GS")
- SET QTY=+$PIECE(NODE,"^",6)
- +6 if +$PIECE($GET(^PSD(58.81,KK,4)),"^",3)
- SET QTY=+$PIECE($GET(^(4)),"^",3)
- +7 IF JJ2=2
- IF $DATA(^PSD(58.81,KK,7))
- IF +$PIECE($GET(^(7)),"^",3)'=PSD
- SET QTY=QTY-(+$PIECE(^(7),"^",7))
- +8 SET QTY=$SELECT(JJ2=3:-(+$PIECE($GET(^PSD(58.81,KK,3)),"^",2)),JJ2=4:-(+$PIECE($GET(^PSD(58.81,KK,3)),"^",5)),JJ2=14:+$PIECE($GET(^PSD(58.81,KK,4)),"^",3),1:QTY)
- +9 IF JJ2=5
- SET PSDTR=+$PIECE($GET(^PSD(58.81,KK,7)),"^",6)
- if PSDTR
- Begin DoDot:1
- +10 IF +$PIECE($GET(^PSD(58.81,PSDTR,0)),"^",18)=PSD
- SET PSDOK=1
- End DoDot:1
- +11 SET NURS=$SELECT(+$PIECE($GET(^PSD(58.81,KK,1)),"^",7):+$PIECE($GET(^(1)),"^",7),1:+$PIECE($GET(^PSD(58.81,KK,1)),"^",3))
- +12 SET NURS=$SELECT($PIECE($GET(^VA(200,NURS,0)),"^")]"":$PIECE(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
- +13 SET ^TMP("PSDNU",$JOB,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_NURS_"^"_$SELECT(JJ2=2:"DISPENSE",JJ2=3:"RET/STK",JJ2=4:"DESTROY",JJ2=5:"TRANSFER",1:"N/A")
- +14 if '$DATA(^TMP("PSDNUT",$JOB,PSDRN))
- SET ^TMP("PSDNUT",$JOB,PSDRN)=0
- if 'PSDOK
- SET ^TMP("PSDNUT",$JOB,PSDRN)=+^TMP("PSDNUT",$JOB,PSDRN)+1
- +15 if '$DATA(^TMP("PSDNUQT",$JOB,PSDRN))
- SET ^TMP("PSDNUQT",$JOB,PSDRN)=0
- SET ^TMP("PSDNUQT",$JOB,PSDRN)=+^TMP("PSDNUQT",$JOB,PSDRN)+QTY
- +16 if '$DATA(^TMP("PSDNUS",$JOB,PSDRN,NAOUN))
- SET ^TMP("PSDNUS",$JOB,PSDRN,NAOUN)=0
- if 'PSDOK
- SET ^TMP("PSDNUS",$JOB,PSDRN,NAOUN)=+^TMP("PSDNUS",$JOB,PSDRN,NAOUN)+1
- +17 if '$DATA(^TMP("PSDNUQ",$JOB,PSDRN,NAOUN))
- SET ^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)=0
- SET ^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)=+^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)+QTY
- +18 if '$DATA(^TMP("PSDNUG",$JOB))
- SET ^TMP("PSDNUG",$JOB)=0
- if 'PSDOK
- SET ^TMP("PSDNUG",$JOB)=+^TMP("PSDNUG",$JOB)+1
- +19 SET PSDOK=0
- +20 QUIT
