- PSDEM1 ;BIR/LTL-Print NAOU Priority Order Report by Drug ;12/14/99 15:11
- ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
- ;
- ; Reference to DD("DD" supported by DBIA # 10017
- ; Reference to $$FMTE^XLFDT( supported by DBIA # 10103
- ; Reference to PSDRUG( supported by DBIA # 221
- ; Reference to VA(200 supported by DBIA # 10060
- ; Reference to PSD(58.8 supported by DBIA # 2711
- ; Reference to PSD(58.81 supported by DBIA # 2808
- ;
- 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 PSDR=0:0 S PSDR=$O(LOC(PSDR)) Q:'PSDR F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"AEM",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"AEM",JJ,JJ1)) Q:'JJ1 D
- .F KK=0:0 S KK=$O(^PSD(58.81,"AEM",JJ,JJ1,PSDR,KK)) Q:'KK D SET
- PRINT ;prints data for stock drugs
- I SUM D ^PSDEM3 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=$$FMTE^XLFDT(JJ,2)
- ..I $Y+8>IOSL D HDR Q:PSDOUT W !,?2,"=> ",NAOU,!!
- ..W NUM,?16,DATE,?35,$J($P(NODE,"^"),6),?47,$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 JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"AEM",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"AEM",JJ,JJ1)) Q:'JJ1 F PSDR=0:0 S PSDR=$O(^PSD(58.81,"AEM",JJ,JJ1,PSDR)) Q:'PSDR D
- .F KK=0:0 S KK=$O(^PSD(58.81,"AEM",JJ,JJ1,PSDR,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 PRIORITY ORDER 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/TIME",!,"DISP #",?16,"FILLED",?35,"QUANTITY",?47,"ORDERED BY",!,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)
- 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:'$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
- PSDEM1 ;BIR/LTL-Print NAOU Priority Order Report by Drug ;12/14/99 15:11
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**20**;13 Feb 97
- +2 ;
- +3 ; Reference to DD("DD" supported by DBIA # 10017
- +4 ; Reference to $$FMTE^XLFDT( supported by DBIA # 10103
- +5 ; Reference to PSDRUG( supported by DBIA # 221
- +6 ; Reference to VA(200 supported by DBIA # 10060
- +7 ; Reference to PSD(58.8 supported by DBIA # 2711
- +8 ; Reference to PSD(58.81 supported by DBIA # 2808
- +9 ;
- 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 PSDR=0:0
- SET PSDR=$ORDER(LOC(PSDR))
- IF 'PSDR
- QUIT
- FOR JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"AEM",JJ))
- IF 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"AEM",JJ,JJ1))
- IF 'JJ1
- QUIT
- Begin DoDot:1
- +4 FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"AEM",JJ,JJ1,PSDR,KK))
- IF 'KK
- QUIT
- DO SET
- End DoDot:1
- PRINT ;prints data for stock drugs
- +1 IF SUM
- DO ^PSDEM3
- 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=$$FMTE^XLFDT(JJ,2)
- +7 IF $Y+8>IOSL
- DO HDR
- IF PSDOUT
- QUIT
- WRITE !,?2,"=> ",NAOU,!!
- +8 WRITE NUM,?16,DATE,?35,$JUSTIFY($PIECE(NODE,"^"),6),?47,$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 JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"AEM",JJ))
- IF 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"AEM",JJ,JJ1))
- IF 'JJ1
- QUIT
- FOR PSDR=0:0
- SET PSDR=$ORDER(^PSD(58.81,"AEM",JJ,JJ1,PSDR))
- IF 'PSDR
- QUIT
- Begin DoDot:1
- +3 FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"AEM",JJ,JJ1,PSDR,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 PRIORITY ORDER 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/TIME",!,"DISP #",?16,"FILLED",?35,"QUANTITY",?47,"ORDERED BY",!,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 SET NURS=$SELECT(+$PIECE($GET(^PSD(58.81,KK,1)),"^",7):+$PIECE($GET(^(1)),"^",7),1:+$PIECE($GET(^PSD(58.81,KK,1)),"^",3))
- +8 SET NURS=$SELECT($PIECE($GET(^VA(200,NURS,0)),"^")]"":$PIECE(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
- +9 SET ^TMP("PSDNU",$JOB,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_NURS
- +10 IF '$DATA(^TMP("PSDNUT",$JOB,PSDRN))
- SET ^TMP("PSDNUT",$JOB,PSDRN)=0
- IF 'PSDOK
- SET ^TMP("PSDNUT",$JOB,PSDRN)=+^TMP("PSDNUT",$JOB,PSDRN)+1
- +11 IF '$DATA(^TMP("PSDNUQT",$JOB,PSDRN))
- SET ^TMP("PSDNUQT",$JOB,PSDRN)=0
- SET ^TMP("PSDNUQT",$JOB,PSDRN)=+^TMP("PSDNUQT",$JOB,PSDRN)+QTY
- +12 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
- +13 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
- +14 IF '$DATA(^TMP("PSDNUG",$JOB))
- SET ^TMP("PSDNUG",$JOB)=0
- IF 'PSDOK
- SET ^TMP("PSDNUG",$JOB)=+^TMP("PSDNUG",$JOB)+1
- +15 SET PSDOK=0
- +16 QUIT
