PSIVAOR ;BIR/PR-BUILD ACT/DC ORDER RPT BY WD/DRUG ;24 JAN 94 / 11:18 AM
;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA# 2191
; Reference to ^DIC(42 is supported by DBIA# 10039
;
SW ;
I XREF="ADC" S STSRPT=1 D DTS^PSIVRQ K STSRPT I '$D(I7)!('$D(I8)) G K
WARD ;Select ward
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
I $P("^OUTPATIENT",X)="" W $P("^OUTPATIENT",X,2) S I3=.5,I11="OUTPATIENT WARD" G DRUG
I X["?" S HELP="ZW" D ^PSIVHLP2 G WARD
S DIC(0)="EQMZ",DIC=42 D ^DIC G:Y<0 WARD S I3=+Y,I11=$P(Y(0),U)
;
DRUG ;Select drug
R !,"Select DRUG (or enter ^ALL): ",X:DTIME G:'$T!("^"[X) K
I X[U F Y="^ALL" I $P(Y,X)="" W $P(Y,X,2) S I2="ALL",I10="ALL DRUGS" G QUEUE
I X["?" S HELP="ACT" D ^PSIVHLP2 G DRUG
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
G:Y<0 DRUG S I2=+Y,I10=$P(Y(0),U)
;
QUEUE ;Ask to queue report
K %ZIS,IOP,IO("Q") S %ZIS="QM",%ZIS("B")=PSIVPR D ^%ZIS I POP W !,"No Device selected or report run." G K
I $D(IO("Q")) D
.K IO("Q")
.S I6=$S($G(IO("DOC"))'="":ION_";"_IO("DOC"),1:ION),ZTIO=""
.K ZTSAVE,ZTDTH,ZTSK
.S ZTDESC="ACTIVE ORDER REPORT BY WARD/DRUG (SORT)",ZTRTN="ENQ1^PSIVAOR"
.F G="I6","I2","I3","XREF","I11","FI","I8","I7","I10","PSJSYSW0","PSJSYSU","PSJSYSP0" S ZTSAVE(G)=""
I D ^%ZTLOAD W:$D(ZTSK) !,"Queued." D ^%ZISC G K
;
ENQ1 ;Entry from first queue or fall through
I '$D(I6) D WAIT^DICD
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
G Q2
;
AIV ;Active orders
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
Q
ADC ;Discontinued orders
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
Q
;
Q2 ;Do second queue
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)=""
S %ZIS="QN",IOP=I6 D ^%ZIS,^%ZTLOAD G K
;
;
1 ;1 w 1 d
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
Q
2 ;1 w all d
I $P(G,U,22)=I3 S W42=$S(I3=.5:"OUTPATIENT",1:$P(^DIC(42,I3,0),U)) D B
Q
;
3 ;All w all d
S W42=$P(G,U,22),W42=$S(W42=.5:"OUTPATIENT",$D(^DIC(42,+W42,0)):$P(^(0),U),1:"zz") D B
Q
;
4 ;1 d all w
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
Q
;
B ;;Build TMP
S ^TMP("PSJ",$J,IV,W42,VADM(1)_U_DFN_U_$E(VADM(2),6,9)_U_VAIN(5),ON_U_P4)="" Q
;
ENQ2 ;Entry second queue
I XREF="ADC" S Y=I7 X ^DD("DD") S RANGE=Y,Y=I8 X ^DD("DD") S RANGE=RANGE_" THROUGH "_Y
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
D H,^PSIVAOR1 G K
H ;
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 "===="
Q
K ;
W:$E($G(IOST),1)'="C"&($Y) @IOF
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
S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVAOR 4077 printed Sep 23, 2025@19:39:58 Page 2
PSIVAOR ;BIR/PR-BUILD ACT/DC ORDER RPT BY WD/DRUG ;24 JAN 94 / 11:18 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA# 2191
+4 ; Reference to ^DIC(42 is supported by DBIA# 10039
+5 ;
SW ;
+1 IF XREF="ADC"
SET STSRPT=1
DO DTS^PSIVRQ
KILL STSRPT
IF '$DATA(I7)!('$DATA(I8))
GOTO K
WARD ;Select ward
+1 READ !!,"Select Ward (or enter ^ALL or ^OUTPATIENT): ",X:DTIME
if '$TEST!("^"[X)
GOTO K
IF $PIECE("^ALL",X)=""
WRITE $PIECE("^ALL",X,2)
SET I3="ALL"
SET I11="ALL WARDS"
GOTO DRUG
+2 IF $PIECE("^OUTPATIENT",X)=""
WRITE $PIECE("^OUTPATIENT",X,2)
SET I3=.5
SET I11="OUTPATIENT WARD"
GOTO DRUG
+3 IF X["?"
SET HELP="ZW"
DO ^PSIVHLP2
GOTO WARD
+4 SET DIC(0)="EQMZ"
SET DIC=42
DO ^DIC
if Y<0
GOTO WARD
SET I3=+Y
SET I11=$PIECE(Y(0),U)
+5 ;
DRUG ;Select drug
+1 READ !,"Select DRUG (or enter ^ALL): ",X:DTIME
if '$TEST!("^"[X)
GOTO K
+2 IF X[U
FOR Y="^ALL"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
SET I2="ALL"
SET I10="ALL DRUGS"
GOTO QUEUE
+3 IF X["?"
SET HELP="ACT"
DO ^PSIVHLP2
GOTO DRUG
+4 FOR FI=52.6,52.7
SET DIC=FI
SET DIC(0)="EQMZ"
DO ^DIC
if X["?"&(DIC[7)
GOTO DRUG
IF Y>0
SET FI=$SELECT(FI[6:"AD",1:"SOL")
QUIT
+5 if Y<0
GOTO DRUG
SET I2=+Y
SET I10=$PIECE(Y(0),U)
+6 ;
QUEUE ;Ask to queue report
+1 KILL %ZIS,IOP,IO("Q")
SET %ZIS="QM"
SET %ZIS("B")=PSIVPR
DO ^%ZIS
IF POP
WRITE !,"No Device selected or report run."
GOTO K
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 KILL IO("Q")
+4 SET I6=$SELECT($GET(IO("DOC"))'="":ION_";"_IO("DOC"),1:ION)
SET ZTIO=""
+5 KILL ZTSAVE,ZTDTH,ZTSK
+6 SET ZTDESC="ACTIVE ORDER REPORT BY WARD/DRUG (SORT)"
SET ZTRTN="ENQ1^PSIVAOR"
+7 FOR G="I6","I2","I3","XREF","I11","FI","I8","I7","I10","PSJSYSW0","PSJSYSU","PSJSYSP0"
SET ZTSAVE(G)=""
End DoDot:1
+8 IF $TEST
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
DO ^%ZISC
GOTO K
+9 ;
ENQ1 ;Entry from first queue or fall through
+1 IF '$DATA(I6)
DO WAIT^DICD
+2 DO NOW^%DTC
SET PSIVQ=$SELECT(XREF="AIV":%-.0001,1:I7-1)
KILL ^TMP("PSJ",$JOB)
SET S=$SELECT(I3&(I2):1,I3&('I2):2,'I3&('I2):3,1:4)
FOR DAT=PSIVQ:0
SET DAT=$ORDER(^PS(55,XREF,DAT))
if 'DAT
QUIT
if XREF="ADC"&($PIECE(DAT,".")>$SELECT($DATA(I8)
QUIT
DO @XREF
+3 GOTO Q2
+4 ;
AIV ;Active orders
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,XREF,DAT,DFN))
if 'DFN
QUIT
DO ENIV^PSJAC
IF '$DATA(PSIVDCF)
DO NOW^%DTC
FOR ON=0:0
SET ON=$ORDER(^PS(55,XREF,DAT,DFN,ON))
if 'ON
QUIT
IF $DATA(^PS(55,DFN,"IV",ON,0))
IF "AOHR"[$PIECE(^(0),U,17)
IF $PIECE(^(0),U,3)>%
SET G=^(0)
SET P4=$PIECE(G,U,4)
SET IV=$PIECE(^(2),U,2)
DO @S
+2 QUIT
ADC ;Discontinued orders
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,XREF,DAT,DFN))
if 'DFN
QUIT
DO ENIV^PSJAC
DO NOW^%DTC
FOR ON=0:0
SET ON=$ORDER(^PS(55,XREF,DAT,DFN,ON))
if 'ON
QUIT
IF $DATA(^PS(55,DFN,"IV",ON,0))
IF $PIECE(^(0),U,17)="D"
SET G=^(0)
SET P4=$PIECE(G,U,4)
SET IV=$PIECE(^(2),U,2)
DO @S
+2 QUIT
+3 ;
Q2 ;Do second queue
+1 if '$DATA(I6)
GOTO ENQ2
SET ZTIO=I6
SET ZTDESC="ACTIVE ORDER REPORT BY WARD/DRUG (PRINT)"
SET ZTRTN="ENQ2^PSIVAOR"
SET ZTDTH=$HOROLOG
FOR JJ="^TMP(""PSJ"",$J,","I3","I2","I11","FI","XREF","I8","I7","I6","I10","PSJSYSW0","PSJSYSU","PSJSYSP0"
SET ZTSAVE(JJ)=""
+2 SET %ZIS="QN"
SET IOP=I6
DO ^%ZIS
DO ^%ZTLOAD
GOTO K
+3 ;
+4 ;
1 ;1 w 1 d
+1 if $PIECE(G,U,22)'=I3
QUIT
FOR NA=0:0
SET NA=$ORDER(^PS(55,DFN,"IV",ON,FI,NA))
if 'NA
QUIT
IF $DATA(^(NA,0))
IF +^(0)=I2
SET W42=$SELECT(I3=.5:"OUTPATIENT",1:$PIECE(^DIC(42,I3,0),U))
DO B
+2 QUIT
2 ;1 w all d
+1 IF $PIECE(G,U,22)=I3
SET W42=$SELECT(I3=.5:"OUTPATIENT",1:$PIECE(^DIC(42,I3,0),U))
DO B
+2 QUIT
+3 ;
3 ;All w all d
+1 SET W42=$PIECE(G,U,22)
SET W42=$SELECT(W42=.5:"OUTPATIENT",$DATA(^DIC(42,+W42,0)):$PIECE(^(0),U),1:"zz")
DO B
+2 QUIT
+3 ;
4 ;1 d all w
+1 SET W42=$PIECE(G,U,22)
SET W42=$SELECT(W42=.5:"OUTPATIENT",$DATA(^DIC(42,+W42,0)):$PIECE(^(0),U),1:"zz")
FOR NA=0:0
SET NA=$ORDER(^PS(55,DFN,"IV",ON,FI,NA))
if 'NA
QUIT
IF $DATA(^(NA,0))
IF +^(0)=I2
DO B
+2 QUIT
+3 ;
B ;;Build TMP
+1 SET ^TMP("PSJ",$JOB,IV,W42,VADM(1)_U_DFN_U_$EXTRACT(VADM(2),6,9)_U_VAIN(5),ON_U_P4)=""
QUIT
+2 ;
ENQ2 ;Entry second queue
+1 IF XREF="ADC"
SET Y=I7
XECUTE ^DD("DD")
SET RANGE=Y
SET Y=I8
XECUTE ^DD("DD")
SET RANGE=RANGE_" THROUGH "_Y
+2 USE IO
SET PG=0
SET I11=I11_", "_I10
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET USER="Printed by: "_$PIECE(^VA(200,DUZ,0),U)_" on "_Y
SET TYPE=$SELECT(XREF="AIV":"Active ",1:"Discontinued ")
IF '$DATA(^TMP("PSJ",$JOB))
DO H
WRITE !,"No data"
GOTO K
+3 DO H
DO ^PSIVAOR1
GOTO K
H ;
+1 SET PG=PG+1
if $Y
WRITE @IOF
WRITE TYPE,"Order Report by Ward/Drug For: ",I11,!,USER
if XREF="ADC"
WRITE !,"Date range: ",RANGE
WRITE ?70,"PAGE: ",PG,!!,"IV ROOM/WARD/NAME/ORDER",?35,"STOP DATE",?60,"PROVIDER",!
FOR I=1:1:20
WRITE "===="
+2 QUIT
K ;
+1 if $EXTRACT($GET(IOST),1)'="C"&($Y)
WRITE @IOF
+2 KILL %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",$JOB)
DO ENIVKV^PSGSETU
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+4 QUIT
