source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVAOR.m@ 862

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

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1PSIVAOR ;BIR/PR-BUILD ACT/DC ORDER RPT BY WD/DRUG ;24 JAN 94 / 11:18 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191
5 ; Reference to ^DIC(42 is supported by DBIA# 10039
6 ;
7SW ;
8 I XREF="ADC" S STSRPT=1 D DTS^PSIVRQ K STSRPT I '$D(I7)!('$D(I8)) G K
9WARD ;Select ward
10 R !!,"Select Ward (or enter ^ALL or ^OUTPATIENT): ",X:DTIME G:'$T!("^"[X) K I $P("^ALL",X)="" W $P("^ALL",X,2) S I3="ALL",I11="ALL WARDS" G DRUG
11 I $P("^OUTPATIENT",X)="" W $P("^OUTPATIENT",X,2) S I3=.5,I11="OUTPATIENT WARD" G DRUG
12 I X["?" S HELP="ZW" D ^PSIVHLP2 G WARD
13 S DIC(0)="EQMZ",DIC=42 D ^DIC G:Y<0 WARD S I3=+Y,I11=$P(Y(0),U)
14 ;
15DRUG ;Select drug
16 R !,"Select DRUG (or enter ^ALL): ",X:DTIME G:'$T!("^"[X) K
17 I X[U F Y="^ALL" I $P(Y,X)="" W $P(Y,X,2) S I2="ALL",I10="ALL DRUGS" G QUEUE
18 I X["?" S HELP="ACT" D ^PSIVHLP2 G DRUG
19 F FI=52.6,52.7 S DIC=FI,DIC(0)="EQMZ" D ^DIC G:X["?"&(DIC[7) DRUG I Y>0 S FI=$S(FI[6:"AD",1:"SOL") Q
20 G:Y<0 DRUG S I2=+Y,I10=$P(Y(0),U)
21 ;
22QUEUE ;Ask to queue report
23 K %ZIS,IOP,IO("Q") S %ZIS="QM",%ZIS("B")=PSIVPR D ^%ZIS I POP W !,"No Device selected or report run." G K
24 I $D(IO("Q")) D
25 .K IO("Q")
26 .S I6=$S($G(IO("DOC"))'="":ION_";"_IO("DOC"),1:ION),ZTIO=""
27 .K ZTSAVE,ZTDTH,ZTSK
28 .S ZTDESC="ACTIVE ORDER REPORT BY WARD/DRUG (SORT)",ZTRTN="ENQ1^PSIVAOR"
29 .F G="I6","I2","I3","XREF","I11","FI","I8","I7","I10","PSJSYSW0","PSJSYSU","PSJSYSP0" S ZTSAVE(G)=""
30 I D ^%ZTLOAD W:$D(ZTSK) !,"Queued." D ^%ZISC G K
31 ;
32ENQ1 ;Entry from first queue or fall through
33 I '$D(I6) D WAIT^DICD
34 D NOW^%DTC S PSIVQ=$S(XREF="AIV":%-.0001,1:I7-1) K ^TMP("PSJ",$J) S S=$S(I3&(I2):1,I3&('I2):2,'I3&('I2):3,1:4) F DAT=PSIVQ:0 S DAT=$O(^PS(55,XREF,DAT)) Q:'DAT Q:XREF="ADC"&($P(DAT,".")>$S($D(I8):I8,1:9999999)) D @XREF
35 G Q2
36 ;
37AIV ;Active orders
38 F DFN=0:0 S DFN=$O(^PS(55,XREF,DAT,DFN)) Q:'DFN D ENIV^PSJAC I '$D(PSIVDCF) D NOW^%DTC F ON=0:0 S ON=$O(^PS(55,XREF,DAT,DFN,ON)) Q:'ON I $D(^PS(55,DFN,"IV",ON,0)),"AOHR"[$P(^(0),U,17),$P(^(0),U,3)>% S G=^(0),P4=$P(G,U,4),IV=$P(^(2),U,2) D @S
39 Q
40ADC ;Discontinued orders
41 F DFN=0:0 S DFN=$O(^PS(55,XREF,DAT,DFN)) Q:'DFN D ENIV^PSJAC,NOW^%DTC F ON=0:0 S ON=$O(^PS(55,XREF,DAT,DFN,ON)) Q:'ON I $D(^PS(55,DFN,"IV",ON,0)),$P(^(0),U,17)="D" S G=^(0),P4=$P(G,U,4),IV=$P(^(2),U,2) D @S
42 Q
43 ;
44Q2 ;Do second queue
45 G:'$D(I6) ENQ2 S ZTIO=I6,ZTDESC="ACTIVE ORDER REPORT BY WARD/DRUG (PRINT)",ZTRTN="ENQ2^PSIVAOR",ZTDTH=$H F JJ="^TMP(""PSJ"",$J,","I3","I2","I11","FI","XREF","I8","I7","I6","I10","PSJSYSW0","PSJSYSU","PSJSYSP0" S ZTSAVE(JJ)=""
46 S %ZIS="QN",IOP=I6 D ^%ZIS,^%ZTLOAD G K
47 ;
48 ;
491 ;1 w 1 d
50 Q:$P(G,U,22)'=I3 F NA=0:0 S NA=$O(^PS(55,DFN,"IV",ON,FI,NA)) Q:'NA I $D(^(NA,0)),+^(0)=I2 S W42=$S(I3=.5:"OUTPATIENT",1:$P(^DIC(42,I3,0),U)) D B
51 Q
522 ;1 w all d
53 I $P(G,U,22)=I3 S W42=$S(I3=.5:"OUTPATIENT",1:$P(^DIC(42,I3,0),U)) D B
54 Q
55 ;
563 ;All w all d
57 S W42=$P(G,U,22),W42=$S(W42=.5:"OUTPATIENT",$D(^DIC(42,+W42,0)):$P(^(0),U),1:"zz") D B
58 Q
59 ;
604 ;1 d all w
61 S W42=$P(G,U,22),W42=$S(W42=.5:"OUTPATIENT",$D(^DIC(42,+W42,0)):$P(^(0),U),1:"zz") F NA=0:0 S NA=$O(^PS(55,DFN,"IV",ON,FI,NA)) Q:'NA I $D(^(NA,0)),+^(0)=I2 D B
62 Q
63 ;
64B ;;Build TMP
65 S ^TMP("PSJ",$J,IV,W42,VADM(1)_U_DFN_U_$E(VADM(2),6,9)_U_VAIN(5),ON_U_P4)="" Q
66 ;
67ENQ2 ;Entry second queue
68 I XREF="ADC" S Y=I7 X ^DD("DD") S RANGE=Y,Y=I8 X ^DD("DD") S RANGE=RANGE_" THROUGH "_Y
69 U IO S PG=0,I11=I11_", "_I10 D NOW^%DTC S Y=% X ^DD("DD") S USER="Printed by: "_$P(^VA(200,DUZ,0),U)_" on "_Y,TYPE=$S(XREF="AIV":"Active ",1:"Discontinued ") I '$D(^TMP("PSJ",$J)) D H W !,"No data" G K
70 D H,^PSIVAOR1 G K
71H ;
72 S PG=PG+1 W:$Y @IOF W TYPE,"Order Report by Ward/Drug For: ",I11,!,USER W:XREF="ADC" !,"Date range: ",RANGE W ?70,"PAGE: ",PG,!!,"IV ROOM/WARD/NAME/ORDER",?35,"STOP DATE",?60,"PROVIDER",! F I=1:1:20 W "===="
73 Q
74K ;
75 W:$E($G(IOST),1)'="C"&($Y) @IOF
76 K %T,D,DAT,DFN,DIC,FI,G,I,I2,I3,I6,I7,I8,I10,I11,IV,NA,ON,P2,P3,P4,P5,P6,PAT,PG,PSIVQ,S,TYPE,USER,VAERR,W42,WD,XREF,Z,ZTSK,^TMP("PSJ",$J) D ENIVKV^PSGSETU
77 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
78 Q
Note: See TracBrowser for help on using the repository browser.