- 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 Mar 13, 2025@21:13:54 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
