- PSDPDU1 ;BIR/JPW-Print Breakdown/Disp Unit (cont'd) ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry point for report
- K ^TMP("PSDPDU",$J)
- F PSD=0:0 S PSD=$O(NAOU(PSD)) G:'PSD PRINT S:$D(^PSD(58.8,PSD,0)) NAOUN=$S($P(^(0),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD) F DRUG=0:0 S DRUG=$O(^PSD(58.8,PSD,1,DRUG)) Q:'DRUG I $D(^PSD(58.8,PSD,1,DRUG,0)) D
- .Q:'$D(^PSD(58.8,PSD,1,DRUG,0)) I +$P(^PSD(58.8,PSD,1,DRUG,0),"^",14) D NOW^%DTC I $P(^PSD(58.8,PSD,1,DRUG,0),"^",14)'>X Q
- .Q:'$D(^PSDRUG(DRUG,0)) I $D(^PSDRUG(DRUG,0)) S DRUGN=$S($P(^PSDRUG(DRUG,0),"^")]"":$P(^(0),"^"),1:"ZZ/"_DRUG)
- .S PSDP=$P($G(^PSD(58.8,PSD,0)),"^",4)
- .S NODE=^PSD(58.8,PSD,1,DRUG,0),NBKU=$P(NODE,"^",8),NPKG=$P(NODE,"^",9)
- .S NDU=$S($P($G(^PSDRUG(DRUG,660)),"^",8)]"":$P($G(^(660)),"^",8),1:"NO DATA"),NDUP=$S($P($G(^(660)),"^",6)]"":$P($G(^(660)),"^",6),1:"NO DATA")
- .S ^TMP("PSDPDU",$J,NAOUN,DRUGN)=NBKU_"^"_NPKG_"^"_NDU_"^"_NDUP
- PRINT ;prints data for stock drugs
- K LN S $P(LN,"-",132)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y D HDR Q:PSDOUT
- I '$D(^TMP("PSDPDU",$J)) W !!,?45,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
- S NAOU="" F S NAOU=$O(^TMP("PSDPDU",$J,NAOU)) Q:NAOU=""!(PSDOUT) D:$Y+5>IOSL HDR Q:PSDOUT W !!,"=> ",$S(NAOU["ZZ/":"#"_$P(NAOU,"/",2)_" NAME MISSING",1:NAOU) D
- .S DRUG="" F S DRUG=$O(^TMP("PSDPDU",$J,NAOU,DRUG)) Q:DRUG=""!(PSDOUT) D Q:PSDOUT
- ..S NODE=^TMP("PSDPDU",$J,NAOU,DRUG),NBKU=$P(NODE,"^"),NPKG=$P(NODE,"^",2),NDU=$P(NODE,"^",3),NDUP=$P(NODE,"^",4)
- ..I $Y+5>IOSL D HDR Q:PSDOUT W !!,"=> ",$S(NAOU["ZZ/":"#"_$P(NAOU,"/",2)_" NAME MISSING",1:NAOU)
- ..W !,?4,DRUG,?58,NBKU,?75,$J(NPKG,6),?93,$J(NDU,6),?118,$J(NDUP,6)
- 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,ANS,DA,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),LN,NAOU,NAOUN,NBKU,NDU,NDUP,NODE,NODED,NPKG,PG,POP,PSD,PSDP,PSDT,PSDOUT,RPDT,TYP,TYPE,X,Y,^TMP("PSDPDU",$J)
- K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- 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 !,"Breakdown/Dispensing Unit Listing - Date: "_RPDT,?121,"PAGE: "_PG,!!,"=> DISPENSING SITE"
- W !,?57,"BREAKDOWN",?75,"PACKAGE",?92,"DISPENSING",?115,"PRICE PER"
- W !,?12,"DRUG",?59,"UNIT",?76,"SIZE",?95,"UNIT",?115,"DISP UNIT",!,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPDU1 2506 printed Apr 23, 2025@18:02:29 Page 2
- PSDPDU1 ;BIR/JPW-Print Breakdown/Disp Unit (cont'd) ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry point for report
- +1 KILL ^TMP("PSDPDU",$JOB)
- +2 FOR PSD=0:0
- SET PSD=$ORDER(NAOU(PSD))
- if 'PSD
- GOTO PRINT
- if $DATA(^PSD(58.8,PSD,0))
- SET NAOUN=$SELECT($PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_PSD)
- FOR DRUG=0:0
- SET DRUG=$ORDER(^PSD(58.8,PSD,1,DRUG))
- if 'DRUG
- QUIT
- IF $DATA(^PSD(58.8,PSD,1,DRUG,0))
- Begin DoDot:1
- +3 if '$DATA(^PSD(58.8,PSD,1,DRUG,0))
- QUIT
- IF +$PIECE(^PSD(58.8,PSD,1,DRUG,0),"^",14)
- DO NOW^%DTC
- IF $PIECE(^PSD(58.8,PSD,1,DRUG,0),"^",14)'>X
- QUIT
- +4 if '$DATA(^PSDRUG(DRUG,0))
- QUIT
- IF $DATA(^PSDRUG(DRUG,0))
- SET DRUGN=$SELECT($PIECE(^PSDRUG(DRUG,0),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_DRUG)
- +5 SET PSDP=$PIECE($GET(^PSD(58.8,PSD,0)),"^",4)
- +6 SET NODE=^PSD(58.8,PSD,1,DRUG,0)
- SET NBKU=$PIECE(NODE,"^",8)
- SET NPKG=$PIECE(NODE,"^",9)
- +7 SET NDU=$SELECT($PIECE($GET(^PSDRUG(DRUG,660)),"^",8)]"":$PIECE($GET(^(660)),"^",8),1:"NO DATA")
- SET NDUP=$SELECT($PIECE($GET(^(660)),"^",6)]"":$PIECE($GET(^(660)),"^",6),1:"NO DATA")
- +8 SET ^TMP("PSDPDU",$JOB,NAOUN,DRUGN)=NBKU_"^"_NPKG_"^"_NDU_"^"_NDUP
- End DoDot:1
- PRINT ;prints data for stock drugs
- +1 KILL LN
- SET $PIECE(LN,"-",132)=""
- SET (PG,PSDOUT)=0
- SET %DT=""
- SET X="T"
- DO ^%DT
- XECUTE ^DD("DD")
- SET RPDT=Y
- DO HDR
- if PSDOUT
- QUIT
- +2 IF '$DATA(^TMP("PSDPDU",$JOB))
- WRITE !!,?45,"***** NO DATA AVAILABLE FOR THIS REPORT *****"
- GOTO DONE
- +3 SET NAOU=""
- FOR
- SET NAOU=$ORDER(^TMP("PSDPDU",$JOB,NAOU))
- if NAOU=""!(PSDOUT)
- QUIT
- if $Y+5>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !!,"=> ",$SELECT(NAOU["ZZ/":"#"_$PIECE(NAOU,"/",2)_" NAME MISSING",1:NAOU)
- Begin DoDot:1
- +4 SET DRUG=""
- FOR
- SET DRUG=$ORDER(^TMP("PSDPDU",$JOB,NAOU,DRUG))
- if DRUG=""!(PSDOUT)
- QUIT
- Begin DoDot:2
- +5 SET NODE=^TMP("PSDPDU",$JOB,NAOU,DRUG)
- SET NBKU=$PIECE(NODE,"^")
- SET NPKG=$PIECE(NODE,"^",2)
- SET NDU=$PIECE(NODE,"^",3)
- SET NDUP=$PIECE(NODE,"^",4)
- +6 IF $Y+5>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !!,"=> ",$SELECT(NAOU["ZZ/":"#"_$PIECE(NAOU,"/",2)_" NAME MISSING",1:NAOU)
- +7 WRITE !,?4,DRUG,?58,NBKU,?75,$JUSTIFY(NPKG,6),?93,$JUSTIFY(NDU,6),?118,$JUSTIFY(NDUP,6)
- End DoDot:2
- if PSDOUT
- QUIT
- 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,ANS,DA,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),LN,NAOU,NAOUN,NBKU,NDU,NDUP,NODE,NODED,NPKG,PG,POP,PSD,PSDP,PSDT,PSDOUT,RPDT,TYP,TYPE,X,Y,^TMP("PSDPDU",$JOB)
- +2 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +3 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +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 !,"Breakdown/Dispensing Unit Listing - Date: "_RPDT,?121,"PAGE: "_PG,!!,"=> DISPENSING SITE"
- +3 WRITE !,?57,"BREAKDOWN",?75,"PACKAGE",?92,"DISPENSING",?115,"PRICE PER"
- +4 WRITE !,?12,"DRUG",?59,"UNIT",?76,"SIZE",?95,"UNIT",?115,"DISP UNIT",!,LN,!
- +5 QUIT
