PSJR0103 ;BIR/JLC-PRINT ORDERS WITH 'BAD' SCHEDULES ;07-JUN-04
;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
;
;Reference to ^PS(50.7 is supported by DBIA# 2180.
;Reference to ^PS(52.6 is supported by DBIA# 1231.
;Reference to ^PS(52.7 is supported by DBIA# 2173.
;
EN I '$D(^XTMP("PSJSC")) W "Nothing on file." Q
W ! K DIR S DIR(0)="F",DIR("A")="Print by Schedule or Patient",DIR("B")="S"
S DIR("?")="Enter S to sort the list of orders by Schedule or P to sort by Patient" D ^DIR
S Y=$TR(Y,"ps","PS") I Y'="P",Y'="S" W "Enter S to sort the list of orders by Schedule or P to sort by Patient" G EN
I Y="^" G EXIT
S PSJSORT=Y
SELDEV ;*** Ask for device type for report to output to ***
K IOP,%ZIS,POP,IO("Q")
W ! S %ZIS("A")="Select output device: ",%ZIS("B")="",%ZIS="Q"
D ^%ZIS I POP W !,"** No device selected **" G EXIT
W:'$D(IO("Q")) !,"this may take a while...(you should QUEUE this report)"
I $D(IO("Q")) D G EXIT
. S XDESC="Problem Schedules on Orders"
. S ZTRTN="START^PSJR0103"
. K IO("Q"),ZTSAVE,ZTDTH,ZTSK
. S ZTDESC=XDESC,PSGIO=ION,ZTIO=PSGIO,ZTDTH=$H,ZTSAVE("PSJSORT")="",%ZIS="QN",IOP=PSGIO
. D ^%ZIS,^%ZTLOAD
;
START ;
U IO K ^TMP("PSJR0103",$J) S PSJPAG=0 D NOW^%DTC S Y=$P(%,".") D DD^%DT S PSJDATE=Y
NSS D HDRN S PSJSCHD=""
F S PSJSCHD=$O(^XTMP("PSJSC","NSSON",PSJSCHD)) Q:PSJSCHD="" D
. S PSJPDFN=""
. F S PSJPDFN=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN)) Q:PSJPDFN="" D
.. S PSJORD=""
.. F S PSJORD=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"UD",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG Q
... D:($Y+5)>IOSL HDR W PSJSCHD,?24,$P(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$P(DRUG,"^"),.01),?78,PSJORD,"U",?86,$P(^PS(50.7,$P(DRUG,"^",2),0),"^"),?118,$P(DRUG,"^",3),! Q
.. F S PSJORD=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"IV",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG Q
... D:($Y+5)>IOSL HDR W PSJSCHD,?24,$P(^DPT(PSJPDFN,0),"^"),"V",?51,$$GET1^DIQ(200,$P(DRUG,"^"),.01),?78,PSJORD,"V",?86,$S($P(DRUG,"^",2)="A":$P(^PS(52.6,$P(DRUG,"^",3),0),"^"),1:$P(^PS(52.7,$P(DRUG,"^",3),0),"^")),?118,$P(DRUG,"^",4),! Q
G:PSJSORT="S" DAN
S PSJPDFN=""
F S PSJPDFN=$O(^TMP("PSJR0103",$J,PSJPDFN)) Q:PSJPDFN="" D
. F TYP="UD","IV" S PSJORD="" D
.. F S PSJORD=$O(^TMP("PSJR0103",$J,PSJPDFN,TYP,PSJORD)) Q:PSJORD="" S A=^(PSJORD) D
... D:($Y+5)>IOSL HDR S DRUG=$P(A,"^",3,99) W $P(^DPT(PSJPDFN,0),"^"),?28,$$GET1^DIQ(200,$P(A,"^",2),.01),?57,$P(A,"^"),?78,PSJORD D
... I TYP="UD" W "U",?86,$P(^PS(50.7,$P(DRUG,"^"),0),"^"),?118,$P(DRUG,"^",2),! Q
... W "V",?86,$S($P(DRUG,"^")="A":$P(^PS(52.6,$P(DRUG,"^",2),0),"^"),1:$P(^PS(52.7,$P(DRUG,"^",2),0),"^")),?118,$P(DRUG,"^",3),!
DAN D HDRD K ^TMP("PSJR0103",$J)
S PSJSCHD=""
F S PSJSCHD=$O(^XTMP("PSJSC","DANON",PSJSCHD)) Q:PSJSCHD="" D
. S PSJPDFN=""
. F S PSJPDFN=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN)) Q:PSJPDFN="" D
.. S PSJORD=""
.. F S PSJORD=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"UD",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG Q
... D:($Y+5)>IOSL HDRD W PSJSCHD,?24,$P(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$P(DRUG,"^"),.01),?78,PSJORD,"U",?86,$P(^PS(50.7,$P(DRUG,"^",2),0),"^"),?118,$P(DRUG,"^",3),! Q
.. F S PSJORD=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"IV",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG Q
... D:($Y+5)>IOSL HDRD W PSJSCHD,?24,$P(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$P(DRUG,"^"),.01),?78,PSJORD,"V",?86,$S($P(DRUG,"^",2)="A":$P(^PS(52.6,$P(DRUG,"^",3),0),"^"),1:$P(^PS(52.7,$P(DRUG,"^",3),0),"^")),?118,$P(DRUG,"^",4),! Q
G:PSJSORT="S" EXIT S PSJPDFN=""
F S PSJPDFN=$O(^TMP("PSJR0103",$J,PSJPDFN)) Q:PSJPDFN="" D
. F TYP="UD","IV" S PSJORD="" D
.. F S PSJORD=$O(^TMP("PSJR0103",$J,PSJPDFN,TYP,PSJORD)) Q:PSJORD="" S A=^(PSJORD) D
... D:($Y+5)>IOSL HDRD S DRUG=$P(A,"^",3,99) W $P(^DPT(PSJPDFN,0),"^"),?28,$$GET1^DIQ(200,$P(A,"^",2),.01),?57,$P(A,"^"),?78,PSJORD D
... I TYP="UD" W "U",?86,$P(^PS(50.7,$P(DRUG,"^"),0),"^"),?118,$P(DRUG,"^",2),! Q
... W "V",?86,$S($P(DRUG,"^")="A":$P(^PS(52.6,$P(DRUG,"^",2),0),"^"),1:$P(^PS(52.7,$P(DRUG,"^",2),0),"^")),?118,$P(DRUG,"^",3),!
EXIT ;
K %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
W:$E(IOST)="C"&($Y) @IOF
S:$D(ZTQUEUED) ZTREQ="@"
S IOP="HOME" D ^%ZISC
Q
HDRN D HDR W ?55,"Non-Standard Schedules",!! I PSJSORT="S" W "Schedule",?24,"Patient",?51,"Provider",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
W "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
HDRD D HDR W ?54,"Dangerous Abbreviations",!! I PSJSORT="S" W "Schedule",?24,"Patient",?51,"Provider",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
W "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
HDR W:$Y @IOF S PSJPAG=PSJPAG+1
W PSJDATE,?47,"Inpatient Medications Schedule Issues",?120,"PAGE: ",PSJPAG,!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJR0103 5193 printed Sep 23, 2025@19:45:10 Page 2
PSJR0103 ;BIR/JLC-PRINT ORDERS WITH 'BAD' SCHEDULES ;07-JUN-04
+1 ;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
+2 ;
+3 ;Reference to ^PS(50.7 is supported by DBIA# 2180.
+4 ;Reference to ^PS(52.6 is supported by DBIA# 1231.
+5 ;Reference to ^PS(52.7 is supported by DBIA# 2173.
+6 ;
EN IF '$DATA(^XTMP("PSJSC"))
WRITE "Nothing on file."
QUIT
+1 WRITE !
KILL DIR
SET DIR(0)="F"
SET DIR("A")="Print by Schedule or Patient"
SET DIR("B")="S"
+2 SET DIR("?")="Enter S to sort the list of orders by Schedule or P to sort by Patient"
DO ^DIR
+3 SET Y=$TRANSLATE(Y,"ps","PS")
IF Y'="P"
IF Y'="S"
WRITE "Enter S to sort the list of orders by Schedule or P to sort by Patient"
GOTO EN
+4 IF Y="^"
GOTO EXIT
+5 SET PSJSORT=Y
SELDEV ;*** Ask for device type for report to output to ***
+1 KILL IOP,%ZIS,POP,IO("Q")
+2 WRITE !
SET %ZIS("A")="Select output device: "
SET %ZIS("B")=""
SET %ZIS="Q"
+3 DO ^%ZIS
IF POP
WRITE !,"** No device selected **"
GOTO EXIT
+4 if '$DATA(IO("Q"))
WRITE !,"this may take a while...(you should QUEUE this report)"
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET XDESC="Problem Schedules on Orders"
+7 SET ZTRTN="START^PSJR0103"
+8 KILL IO("Q"),ZTSAVE,ZTDTH,ZTSK
+9 SET ZTDESC=XDESC
SET PSGIO=ION
SET ZTIO=PSGIO
SET ZTDTH=$HOROLOG
SET ZTSAVE("PSJSORT")=""
SET %ZIS="QN"
SET IOP=PSGIO
+10 DO ^%ZIS
DO ^%ZTLOAD
End DoDot:1
GOTO EXIT
+11 ;
START ;
+1 USE IO
KILL ^TMP("PSJR0103",$JOB)
SET PSJPAG=0
DO NOW^%DTC
SET Y=$PIECE(%,".")
DO DD^%DT
SET PSJDATE=Y
NSS DO HDRN
SET PSJSCHD=""
+1 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","NSSON",PSJSCHD))
if PSJSCHD=""
QUIT
Begin DoDot:1
+2 SET PSJPDFN=""
+3 FOR
SET PSJPDFN=$ORDER(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN))
if PSJPDFN=""
QUIT
Begin DoDot:2
+4 SET PSJORD=""
+5 FOR
SET PSJORD=$ORDER(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"UD",PSJORD))
if PSJORD=""
QUIT
SET DRUG=^(PSJORD)
Begin DoDot:3
+6 IF PSJSORT="P"
SET ^TMP("PSJR0103",$JOB,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG
QUIT
+7 if ($Y+5)>IOSL
DO HDR
WRITE PSJSCHD,?24,$PIECE(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$PIECE(DRUG,"^"),.01),?78,PSJORD,"U",?86,$PIECE(^PS(50.7,$PIECE(DRUG,"^",2),0),"^"),?118,$PIECE(DRUG,"^",3),!
QUIT
End DoDot:3
+8 FOR
SET PSJORD=$ORDER(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"IV",PSJORD))
if PSJORD=""
QUIT
SET DRUG=^(PSJORD)
Begin DoDot:3
+9 IF PSJSORT="P"
SET ^TMP("PSJR0103",$JOB,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG
QUIT
+10 if ($Y+5)>IOSL
DO HDR
WRITE PSJSCHD,?24,$PIECE(^DPT(PSJPDFN,0),"^"),"V",?51,$$GET1^DIQ(200,$PIECE(DRUG,"^"),.01),?78,PSJORD,"V",?86,$SELECT($PIECE(DRUG,"^",2)="A":$PIECE(^PS(52.6,$PIECE(DRUG,"^",3),0),"^"),1:$PIECE(^PS(52.7,$PIECE(DRUG,"^",3)
,0),"^")),?118,$PIECE(DRUG,"^",4),!
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+11 if PSJSORT="S"
GOTO DAN
+12 SET PSJPDFN=""
+13 FOR
SET PSJPDFN=$ORDER(^TMP("PSJR0103",$JOB,PSJPDFN))
if PSJPDFN=""
QUIT
Begin DoDot:1
+14 FOR TYP="UD","IV"
SET PSJORD=""
Begin DoDot:2
+15 FOR
SET PSJORD=$ORDER(^TMP("PSJR0103",$JOB,PSJPDFN,TYP,PSJORD))
if PSJORD=""
QUIT
SET A=^(PSJORD)
Begin DoDot:3
+16 if ($Y+5)>IOSL
DO HDR
SET DRUG=$PIECE(A,"^",3,99)
WRITE $PIECE(^DPT(PSJPDFN,0),"^"),?28,$$GET1^DIQ(200,$PIECE(A,"^",2),.01),?57,$PIECE(A,"^"),?78,PSJORD
Begin DoDot:4
End DoDot:4
+17 IF TYP="UD"
WRITE "U",?86,$PIECE(^PS(50.7,$PIECE(DRUG,"^"),0),"^"),?118,$PIECE(DRUG,"^",2),!
QUIT
+18 WRITE "V",?86,$SELECT($PIECE(DRUG,"^")="A":$PIECE(^PS(52.6,$PIECE(DRUG,"^",2),0),"^"),1:$PIECE(^PS(52.7,$PIECE(DRUG,"^",2),0),"^")),?118,$PIECE(DRUG,"^",3),!
End DoDot:3
End DoDot:2
End DoDot:1
DAN DO HDRD
KILL ^TMP("PSJR0103",$JOB)
+1 SET PSJSCHD=""
+2 FOR
SET PSJSCHD=$ORDER(^XTMP("PSJSC","DANON",PSJSCHD))
if PSJSCHD=""
QUIT
Begin DoDot:1
+3 SET PSJPDFN=""
+4 FOR
SET PSJPDFN=$ORDER(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN))
if PSJPDFN=""
QUIT
Begin DoDot:2
+5 SET PSJORD=""
+6 FOR
SET PSJORD=$ORDER(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"UD",PSJORD))
if PSJORD=""
QUIT
SET DRUG=^(PSJORD)
Begin DoDot:3
+7 IF PSJSORT="P"
SET ^TMP("PSJR0103",$JOB,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG
QUIT
+8 if ($Y+5)>IOSL
DO HDRD
WRITE PSJSCHD,?24,$PIECE(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$PIECE(DRUG,"^"),.01),?78,PSJORD,"U",?86,$PIECE(^PS(50.7,$PIECE(DRUG,"^",2),0),"^"),?118,$PIECE(DRUG,"^",3),!
QUIT
End DoDot:3
+9 FOR
SET PSJORD=$ORDER(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"IV",PSJORD))
if PSJORD=""
QUIT
SET DRUG=^(PSJORD)
Begin DoDot:3
+10 IF PSJSORT="P"
SET ^TMP("PSJR0103",$JOB,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG
QUIT
+11 if ($Y+5)>IOSL
DO HDRD
WRITE PSJSCHD,?24,$PIECE(^DPT(PSJPDFN,0),"^"),?51,$$GET1^DIQ(200,$PIECE(DRUG,"^"),.01),?78,PSJORD,"V",?86,$SELECT($PIECE(DRUG,"^",2)="A":$PIECE(^PS(52.6,$PIECE(DRUG,"^",3),0),"^"),1:$PIECE(^PS(52.7,$PIECE(DRUG,"^",3),0),
"^")),?118,$PIECE(DRUG,"^",4),!
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+12 if PSJSORT="S"
GOTO EXIT
SET PSJPDFN=""
+13 FOR
SET PSJPDFN=$ORDER(^TMP("PSJR0103",$JOB,PSJPDFN))
if PSJPDFN=""
QUIT
Begin DoDot:1
+14 FOR TYP="UD","IV"
SET PSJORD=""
Begin DoDot:2
+15 FOR
SET PSJORD=$ORDER(^TMP("PSJR0103",$JOB,PSJPDFN,TYP,PSJORD))
if PSJORD=""
QUIT
SET A=^(PSJORD)
Begin DoDot:3
+16 if ($Y+5)>IOSL
DO HDRD
SET DRUG=$PIECE(A,"^",3,99)
WRITE $PIECE(^DPT(PSJPDFN,0),"^"),?28,$$GET1^DIQ(200,$PIECE(A,"^",2),.01),?57,$PIECE(A,"^"),?78,PSJORD
Begin DoDot:4
End DoDot:4
+17 IF TYP="UD"
WRITE "U",?86,$PIECE(^PS(50.7,$PIECE(DRUG,"^"),0),"^"),?118,$PIECE(DRUG,"^",2),!
QUIT
+18 WRITE "V",?86,$SELECT($PIECE(DRUG,"^")="A":$PIECE(^PS(52.6,$PIECE(DRUG,"^",2),0),"^"),1:$PIECE(^PS(52.7,$PIECE(DRUG,"^",2),0),"^")),?118,$PIECE(DRUG,"^",3),!
End DoDot:3
End DoDot:2
End DoDot:1
EXIT ;
+1 KILL %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
+2 if $EXTRACT(IOST)="C"&($Y)
WRITE @IOF
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 SET IOP="HOME"
DO ^%ZISC
+5 QUIT
HDRN DO HDR
WRITE ?55,"Non-Standard Schedules",!!
IF PSJSORT="S"
WRITE "Schedule",?24,"Patient",?51,"Provider",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!!
QUIT
+1 WRITE "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!!
QUIT
HDRD DO HDR
WRITE ?54,"Dangerous Abbreviations",!!
IF PSJSORT="S"
WRITE "Schedule",?24,"Patient",?51,"Provider",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!!
QUIT
+1 WRITE "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!!
QUIT
HDR if $Y
WRITE @IOF
SET PSJPAG=PSJPAG+1
+1 WRITE PSJDATE,?47,"Inpatient Medications Schedule Issues",?120,"PAGE: ",PSJPAG,!!
+2 QUIT
