source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJR0103.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSJR0103 ;BIR/JLC-PRINT ORDERS WITH 'BAD' SCHEDULES ;07-JUN-04
2 ;;5.0; INPATIENT MEDICATIONS ;**103**;16 DEC 97
3 ;
4 ;Reference to ^PS(50.7 is supported by DBIA# 2180.
5 ;Reference to ^PS(52.6 is supported by DBIA# 1231.
6 ;Reference to ^PS(52.7 is supported by DBIA# 2173.
7 ;
8EN I '$D(^XTMP("PSJSC")) W "Nothing on file." Q
9 W ! K DIR S DIR(0)="F",DIR("A")="Print by Schedule or Patient",DIR("B")="S"
10 S DIR("?")="Enter S to sort the list of orders by Schedule or P to sort by Patient" D ^DIR
11 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
12 I Y="^" G EXIT
13 S PSJSORT=Y
14SELDEV ;*** Ask for device type for report to output to ***
15 K IOP,%ZIS,POP,IO("Q")
16 W ! S %ZIS("A")="Select output device: ",%ZIS("B")="",%ZIS="Q"
17 D ^%ZIS I POP W !,"** No device selected **" G EXIT
18 W:'$D(IO("Q")) !,"this may take a while...(you should QUEUE this report)"
19 I $D(IO("Q")) D G EXIT
20 . S XDESC="Problem Schedules on Orders"
21 . S ZTRTN="START^PSJR0103"
22 . K IO("Q"),ZTSAVE,ZTDTH,ZTSK
23 . S ZTDESC=XDESC,PSGIO=ION,ZTIO=PSGIO,ZTDTH=$H,ZTSAVE("PSJSORT")="",%ZIS="QN",IOP=PSGIO
24 . D ^%ZIS,^%ZTLOAD
25 ;
26START ;
27 U IO K ^TMP("PSJR0103",$J) S PSJPAG=0 D NOW^%DTC S Y=$P(%,".") D DD^%DT S PSJDATE=Y
28NSS D HDRN S PSJSCHD=""
29 F S PSJSCHD=$O(^XTMP("PSJSC","NSSON",PSJSCHD)) Q:PSJSCHD="" D
30 . S PSJPDFN=""
31 . F S PSJPDFN=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN)) Q:PSJPDFN="" D
32 .. S PSJORD=""
33 .. F S PSJORD=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"UD",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
34 ... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG Q
35 ... 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
36 .. F S PSJORD=$O(^XTMP("PSJSC","NSSON",PSJSCHD,PSJPDFN,"IV",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
37 ... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG Q
38 ... 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
39 G:PSJSORT="S" DAN
40 S PSJPDFN=""
41 F S PSJPDFN=$O(^TMP("PSJR0103",$J,PSJPDFN)) Q:PSJPDFN="" D
42 . F TYP="UD","IV" S PSJORD="" D
43 .. F S PSJORD=$O(^TMP("PSJR0103",$J,PSJPDFN,TYP,PSJORD)) Q:PSJORD="" S A=^(PSJORD) D
44 ... 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
45 ... I TYP="UD" W "U",?86,$P(^PS(50.7,$P(DRUG,"^"),0),"^"),?118,$P(DRUG,"^",2),! Q
46 ... 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),!
47DAN D HDRD K ^TMP("PSJR0103",$J)
48 S PSJSCHD=""
49 F S PSJSCHD=$O(^XTMP("PSJSC","DANON",PSJSCHD)) Q:PSJSCHD="" D
50 . S PSJPDFN=""
51 . F S PSJPDFN=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN)) Q:PSJPDFN="" D
52 .. S PSJORD=""
53 .. F S PSJORD=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"UD",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
54 ... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"UD",PSJORD)=PSJSCHD_"^"_DRUG Q
55 ... 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
56 .. F S PSJORD=$O(^XTMP("PSJSC","DANON",PSJSCHD,PSJPDFN,"IV",PSJORD)) Q:PSJORD="" S DRUG=^(PSJORD) D
57 ... I PSJSORT="P" S ^TMP("PSJR0103",$J,PSJPDFN,"IV",PSJORD)=PSJSCHD_"^"_DRUG Q
58 ... 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
59 G:PSJSORT="S" EXIT S PSJPDFN=""
60 F S PSJPDFN=$O(^TMP("PSJR0103",$J,PSJPDFN)) Q:PSJPDFN="" D
61 . F TYP="UD","IV" S PSJORD="" D
62 .. F S PSJORD=$O(^TMP("PSJR0103",$J,PSJPDFN,TYP,PSJORD)) Q:PSJORD="" S A=^(PSJORD) D
63 ... 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
64 ... I TYP="UD" W "U",?86,$P(^PS(50.7,$P(DRUG,"^"),0),"^"),?118,$P(DRUG,"^",2),! Q
65 ... 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),!
66EXIT ;
67 K %,%H,%I,%ZIS,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
68 W:$E(IOST)="C"&($Y) @IOF
69 S:$D(ZTQUEUED) ZTREQ="@"
70 S IOP="HOME" D ^%ZISC
71 Q
72HDRN 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
73 W "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
74HDRD 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
75 W "Patient",?28,"Provider",?57,"Schedule",?78,"Order",?86,"OI/Additive/Sol",?118,"Dos/Str/Vol",!! Q
76HDR W:$Y @IOF S PSJPAG=PSJPAG+1
77 W PSJDATE,?47,"Inpatient Medications Schedule Issues",?120,"PAGE: ",PSJPAG,!!
78 Q
Note: See TracBrowser for help on using the repository browser.