PSIVRNL ;BIR/RGY-PRINT RENEWAL AND ACTIVE ORDER LIST ; 15 May 98 / 9:27 AM
;;5.0; INPATIENT MEDICATIONS ;**3,137**;16 DEC 97
;
ENRNL ;
D ^PSIVXU I $D(XQUIT) K XQUIT Q
D BEGRNL K DFN,I,ON,P,PSIV,PSIV1,PSIVBEG,PSIVDT,PSIVEND,PSIVRUN,WARD,WRD,WRDB,WRDE,VAERR,Z
Q
;
BEGRNL W ! S %DT="EXT",X="Enter beginning date: ^T@0001^^^1" D ENQ^PSIV,^%DT G:X["^" QRNL G:Y<0&(X'="?") BEGRNL I X["?" S HELP="RNL" D ^PSIVHLP G BEGRNL
S PSIVBEG=Y I Y'["." W $C(7),!!,"*** Please enter time with date. ***",! G BEGRNL
ENDRNL W ! S X="Enter ending date: ^T@2400^^^1" D ENQ^PSIV,^%DT G:X["^" QRNL G:Y<0&(X'="?") ENDRNL I X["?" S HELP="RNL" D ^PSIVHLP G ENDRNL
I Y'["." W $C(7),!!,"*** Please enter time with date. ***",! G ENDRNL
EN1 S PSIVEND=Y K WRD
BEG K DIR S DIR(0)="F^1:30",DIR("A")="Start at WARD",DIR("B")="BEG"
S DIR("?")="or enter any ward.",DIR("?",1)="Press <RETURN> to start from the first ward",DIR("?",2)="or enter ""^Outpatient"" for Outpatient IV"
D ^DIR
G QRNL:$D(DTOUT)!("^"[X) I X="BEG" S WRDB="" G END
S X=$$ENLU^PSGMI(X) I "^OUTPATIENT"[X W $P("^OUTPATIENT IV",X,2) S WRDB="Outpatient IV" G END
I X]"" K DA,DIC S DIC="^DIC(42,",DIC(0)="QEM" D ^DIC K DA,DIC G:Y<1 BEG
S WRDB=$P(Y,"^",2)
END K DIR S DIR(0)="F^1:30",DIR("A")="Stop at WARD",DIR("B")="END"
S DIR("?")="or enter any ward.",DIR("?",1)="Press <RETURN> to stop at the last ward",DIR("?",2)="or enter ""^Outpatient"" for Outpatient IV"
D ^DIR
G QRNL:$D(DTOUT)!("^"[X) I X="END" S WRDE="z" G WRD
S X=$$ENLU^PSGMI(X) I "^OUTPATIENT"[X W $P("^OUTPATIENT IV",X,2) S WRDE="Outpatient IV" G WRD
I X]"" K DA,DIC S DIC="^DIC(42,",DIC(0)="QEM" D ^DIC K DA,DIC G:Y<1 END
S WRDE=$P(Y,"^",2)
WRD S WRDB=$E(WRDB,1,$L(WRDB)-1)_$C($A(WRDB,$L(WRDB))-1),WRDE=$E(WRDE,1,$L(WRDE)-1)_$C($A(WRDE,$L(WRDE))+1) K X S X(WRDE)=""
I $O(X(WRDB))'=WRDE W ! K DIR S DIR(0)="E",DIR("A",1)="The starting ward must be alphabetically before the ending ward.",DIR("A")="Press <RETURN> to continue" D ^DIR K X G BEG
I PSIVPR'=ION D QUERNL G QRNL
DEQRNL K ^UTILITY("PSIV",$J) S (WARD,^($J,WRDE))="" D NOW^%DTC S:$E(PSIVEND)=9 PSIVBEG=% S PSIVRUN=$E(%,1,12)
F PSIVDT=PSIVBEG-.0001:0 S PSIVDT=$O(^PS(55,"AIV",PSIVDT)) Q:'PSIVDT!(PSIVDT>PSIVEND) F DFN=0:0 S DFN=$O(^PS(55,"AIV",PSIVDT,DFN)) Q:'DFN D DEQRNL1
S WRD=WRDB F PSIV1=0:0 S WRD=$O(^UTILITY("PSIV",$J,WRD)) Q:WRD=""!(WRDE']WRD) F DFN=0:0 S DFN=$O(^UTILITY("PSIV",$J,WRD,DFN)) Q:'DFN F ON=0:0 S ON=$O(^UTILITY("PSIV",$J,WRD,DFN,ON)) Q:'ON D SETP,CHK
QRNL W:'$D(PSIVPR)&($Y) @IOF K ^UTILITY("PSIV",$J) S:$D(ZTQUEUED) ZTREQ="@" Q
WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
Q
;
DEQRNL1 ;
S PSIV("NME")=$P($G(^DPT(DFN,0)),U) D INP^VADPT F ON=0:0 S ON=$O(^PS(55,"AIV",PSIVDT,DFN,ON)) Q:'ON D SETP,UT
Q
PRNT D:$Y+7>IOSL!(WARD'=WRD) HDR D ENIV^PSJAC W !,VAIN(5),?30 S PSIV=$O(^PS(55,DFN,"IV",ON,"AD",0)) D:PSIV ENP2 W ?80 S Y=P(3) D WD W ?105,$P($G(^VA(200,+P(6),0)),"^")
ENP1 W !,VADM(1)
S SSNF=0
ENP3 I PSIV]"" S PSIV=$O(^PS(55,DFN,"IV",ON,"AD",PSIV)) I PSIV D ENP2 W ! D CHK2
I PSIV]"" F PSIV=PSIV:0 S PSIV=$O(^PS(55,DFN,"IV",ON,"AD",PSIV)) Q:'PSIV D ENP2 W ! D CHK2
F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",ON,"SOL",PSIV)) Q:'PSIV D
.; naked ref below refers to line above
.S PSIV=PSIV_"^"_^(PSIV,0) W ?30,$S($D(^PS(52.7,$P(PSIV,"^",2),0)):$P(^(0),"^")_" "_$P(PSIV,"^",3)_" "_$P(^(0),"^",4),1:"*** Undefined Solution"),! D CHK2
W:P(8)]"" ?30,$P(P(8),"@"),! D CHK2
W:P(9)]"" ?30,P(9) W:P(11)]"" " (",P(11),")" W:P(9)_P(11)]"" ! D CHK2
S PSIV=$S($D(^PS(55,DFN,"IV",ON,3)):$P(^(3),"^"),1:"") W:PSIV]"" ?30,"Other print info.: ",PSIV,! D CHK2
; naked ref below refers to line above
S PSIV=$S($D(^(1)):$P(^(1),"^"),1:"") W:PSIV]"" ?40,"Remarks: ",PSIV,! D CHK2
I "OHD"[P(17) S Y=^DD(55.01,100,0),X=P(17),X=$P($P(";"_$P(Y,"^",3),";"_X_":",2),";") W ?30,"*** THIS ORDER HAS A STATUS OF '",X,"' ***",!
D CHK2 K SSNF Q
ENP2 S PSIV=PSIV_"^"_^PS(55,DFN,"IV",ON,"AD",+PSIV,0) W ?30,$S($D(^PS(52.6,$P(PSIV,"^",2),0)):$P(^(0),"^")_" "_$P(PSIV,"^",3),1:"*** Undefined Additive") I $P(PSIV,"^",4)]"" W " (",$P(PSIV,"^",4),")"
S PSIV=+PSIV Q
HDR W:$Y @IOF,!! I $E(PSIVEND)=9 W "Active order list"
E W "Renewal list from " S Y=PSIVBEG D WD W " to " S Y=PSIVEND D WD
W !,"Printed on: " S Y=PSIVRUN D WD W !!,"Patient name",?40,"Order",?80,"Stop date",?105,"Provider",! F Y=1:1:130 W "-"
S WARD=WRD W !?50,"**** Ward: ",WRD," ****" W ! Q
QUERNL S ZTIO=PSIVPR,ZTDESC="IV "_$S($E(PSIVEND)=9:"ACTIVE ORDER",1:"RENEWAL")_" LIST",ZTRTN="DEQRNL^PSIVRNL" F X="WRDE","WRDB","PSIVBEG","PSIVEND","PSIVSITE","PSIVSN","PSJSYSW0","PSJSYSU","PSJSYSP","PSJSYSP0" S ZTSAVE(X)=""
D ^%ZTLOAD W:$D(ZTSK) !,"Queued." G QRNL
UT S ^UTILITY("PSIV",$J,$S($P(VAIN(4),U,2)]"":$P(VAIN(4),U,2),1:"Outpatient IV"),DFN,ON)="" Q
CHK I "DEPN"'[P(17),$P($G(^PS(55,DFN,"IV",ON,2)),U,2)=PSIVSN D:$S($E(PSIVEND)=9:1,1:$P(^(2),U,9)'="R") PRNT
Q
ENTACT D NOW^%DTC S PSIVBEG=%,Y=9999999 G EN1
CHK2 I '$G(SSNF) W VA("BID")," [",ON,"]" S SSNF=1 Q
PSIVRNL ;BIR/RGY-PRINT RENEWAL AND ACTIVE ORDER LIST ; 15 May 98 / 9:27 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3,137**;16 DEC 97
+2 ;
ENRNL ;
+1 DO ^PSIVXU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+2 DO BEGRNL
KILL DFN,I,ON,P,PSIV,PSIV1,PSIVBEG,PSIVDT,PSIVEND,PSIVRUN,WARD,WRD,WRDB,WRDE,VAERR,Z
+3 QUIT
+4 ;
BEGRNL WRITE !
SET %DT="EXT"
SET X="Enter beginning date: ^T@0001^^^1"
DO ENQ^PSIV
DO ^%DT
IF X["^"
GOTO QRNL
IF Y<0&(X'="?")
GOTO BEGRNL
IF X["?"
SET HELP="RNL"
DO ^PSIVHLP
GOTO BEGRNL
+1 SET PSIVBEG=Y
IF Y'["."
WRITE $CHAR(7),!!,"*** Please enter time with date. ***",!
GOTO BEGRNL
ENDRNL WRITE !
SET X="Enter ending date: ^T@2400^^^1"
DO ENQ^PSIV
DO ^%DT
IF X["^"
GOTO QRNL
IF Y<0&(X'="?")
GOTO ENDRNL
IF X["?"
SET HELP="RNL"
DO ^PSIVHLP
GOTO ENDRNL
+1 IF Y'["."
WRITE $CHAR(7),!!,"*** Please enter time with date. ***",!
GOTO ENDRNL
EN1 SET PSIVEND=Y
KILL WRD
BEG KILL DIR
SET DIR(0)="F^1:30"
SET DIR("A")="Start at WARD"
SET DIR("B")="BEG"
+1 SET DIR("?")="or enter any ward."
SET DIR("?",1)="Press <RETURN> to start from the first ward"
SET DIR("?",2)="or enter ""^Outpatient"" for Outpatient IV"
+2 DO ^DIR
+3 IF $DATA(DTOUT)!("^"[X)
GOTO QRNL
IF X="BEG"
SET WRDB=""
GOTO END
+4 SET X=$$ENLU^PSGMI(X)
IF "^OUTPATIENT"[X
WRITE $PIECE("^OUTPATIENT IV",X,2)
SET WRDB="Outpatient IV"
GOTO END
+5 IF X]""
KILL DA,DIC
SET DIC="^DIC(42,"
SET DIC(0)="QEM"
DO ^DIC
KILL DA,DIC
IF Y<1
GOTO BEG
+6 SET WRDB=$PIECE(Y,"^",2)
END KILL DIR
SET DIR(0)="F^1:30"
SET DIR("A")="Stop at WARD"
SET DIR("B")="END"
+1 SET DIR("?")="or enter any ward."
SET DIR("?",1)="Press <RETURN> to stop at the last ward"
SET DIR("?",2)="or enter ""^Outpatient"" for Outpatient IV"
+2 DO ^DIR
+3 IF $DATA(DTOUT)!("^"[X)
GOTO QRNL
IF X="END"
SET WRDE="z"
GOTO WRD
+4 SET X=$$ENLU^PSGMI(X)
IF "^OUTPATIENT"[X
WRITE $PIECE("^OUTPATIENT IV",X,2)
SET WRDE="Outpatient IV"
GOTO WRD
+5 IF X]""
KILL DA,DIC
SET DIC="^DIC(42,"
SET DIC(0)="QEM"
DO ^DIC
KILL DA,DIC
IF Y<1
GOTO END
+6 SET WRDE=$PIECE(Y,"^",2)
WRD SET WRDB=$EXTRACT(WRDB,1,$LENGTH(WRDB)-1)_$CHAR($ASCII(WRDB,$LENGTH(WRDB))-1)
SET WRDE=$EXTRACT(WRDE,1,$LENGTH(WRDE)-1)_$CHAR($ASCII(WRDE,$LENGTH(WRDE))+1)
KILL X
SET X(WRDE)=""
+1 IF $ORDER(X(WRDB))'=WRDE
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A",1)="The starting ward must be alphabetically before the ending ward."
SET DIR("A")="Press <RETURN> to continue"
DO ^DIR
KILL X
GOTO BEG
+2 IF PSIVPR'=ION
DO QUERNL
GOTO QRNL
DEQRNL KILL ^UTILITY("PSIV",$JOB)
SET (WARD,^($JOB,WRDE))=""
DO NOW^%DTC
IF $EXTRACT(PSIVEND)=9
SET PSIVBEG=%
SET PSIVRUN=$EXTRACT(%,1,12)
+1 FOR PSIVDT=PSIVBEG-.0001:0
SET PSIVDT=$ORDER(^PS(55,"AIV",PSIVDT))
IF 'PSIVDT!(PSIVDT>PSIVEND)
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"AIV",PSIVDT,DFN))
IF 'DFN
QUIT
DO DEQRNL1
+2 SET WRD=WRDB
FOR PSIV1=0:0
SET WRD=$ORDER(^UTILITY("PSIV",$JOB,WRD))
IF WRD=""!(WRDE']WRD)
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^UTILITY("PSIV",$JOB,WRD,DFN))
IF 'DFN
QUIT
FOR ON=0:0
SET ON=$ORDER(^UTILITY("PSIV",$JOB,WRD,DFN,ON))
IF 'ON
QUIT
DO SETP
DO CHK
QRNL IF '$DATA(PSIVPR)&($Y)
WRITE @IOF
KILL ^UTILITY("PSIV",$JOB)
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
WD XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2)
QUIT
SETP SET Y=^PS(55,DFN,"IV",ON,0)
FOR X=1:1:23
SET P(X)=$PIECE(Y,"^",X)
+1 QUIT
+2 ;
DEQRNL1 ;
+1 SET PSIV("NME")=$PIECE($GET(^DPT(DFN,0)),U)
DO INP^VADPT
FOR ON=0:0
SET ON=$ORDER(^PS(55,"AIV",PSIVDT,DFN,ON))
IF 'ON
QUIT
DO SETP
DO UT
+2 QUIT
PRNT IF $Y+7>IOSL!(WARD'=WRD)
DO HDR
DO ENIV^PSJAC
WRITE !,VAIN(5),?30
SET PSIV=$ORDER(^PS(55,DFN,"IV",ON,"AD",0))
IF PSIV
DO ENP2
WRITE ?80
SET Y=P(3)
DO WD
WRITE ?105,$PIECE($GET(^VA(200,+P(6),0)),"^")
ENP1 WRITE !,VADM(1)
+1 SET SSNF=0
ENP3 IF PSIV]""
SET PSIV=$ORDER(^PS(55,DFN,"IV",ON,"AD",PSIV))
IF PSIV
DO ENP2
WRITE !
DO CHK2
+1 IF PSIV]""
FOR PSIV=PSIV:0
SET PSIV=$ORDER(^PS(55,DFN,"IV",ON,"AD",PSIV))
IF 'PSIV
QUIT
DO ENP2
WRITE !
DO CHK2
+2 FOR PSIV=0:0
SET PSIV=$ORDER(^PS(55,DFN,"IV",ON,"SOL",PSIV))
IF 'PSIV
QUIT
Begin DoDot:1
+3 ; naked ref below refers to line above
+4 SET PSIV=PSIV_"^"_^(PSIV,0)
WRITE ?30,$SELECT($DATA(^PS(52.7,$PIECE(PSIV,"^",2),0)):$PIECE(^(0),"^")_" "_$PIECE(PSIV,"^",3)_" "_$PIECE(^(0),"^",4),1:"*** Undefined Solution"),!
DO CHK2
End DoDot:1
+5 IF P(8)]""
WRITE ?30,$PIECE(P(8),"@"),!
DO CHK2
+6 IF P(9)]""
WRITE ?30,P(9)
IF P(11)]""
WRITE " (",P(11),")"
IF P(9)_P(11)]""
WRITE !
DO CHK2
+7 SET PSIV=$SELECT($DATA(^PS(55,DFN,"IV",ON,3)):$PIECE(^(3),"^"),1:"")
IF PSIV]""
WRITE ?30,"Other print info.: ",PSIV,!
DO CHK2
+8 ; naked ref below refers to line above
+9 SET PSIV=$SELECT($DATA(^(1)):$PIECE(^(1),"^"),1:"")
IF PSIV]""
WRITE ?40,"Remarks: ",PSIV,!
DO CHK2
+10 IF "OHD"[P(17)
SET Y=^DD(55.01,100,0)
SET X=P(17)
SET X=$PIECE($PIECE(";"_$PIECE(Y,"^",3),";"_X_":",2),";")
WRITE ?30,"*** THIS ORDER HAS A STATUS OF '",X,"' ***",!
+11 DO CHK2
KILL SSNF
QUIT
ENP2 SET PSIV=PSIV_"^"_^PS(55,DFN,"IV",ON,"AD",+PSIV,0)
WRITE ?30,$SELECT($DATA(^PS(52.6,$PIECE(PSIV,"^",2),0)):$PIECE(^(0),"^")_" "_$PIECE(PSIV,"^",3),1:"*** Undefined Additive")
IF $PIECE(PSIV,"^",4)]""
WRITE " (",$PIECE(PSIV,"^",4),")"
+1 SET PSIV=+PSIV
QUIT
HDR IF $Y
WRITE @IOF,!!
IF $EXTRACT(PSIVEND)=9
WRITE "Active order list"
+1 IF '$TEST
WRITE "Renewal list from "
SET Y=PSIVBEG
DO WD
WRITE " to "
SET Y=PSIVEND
DO WD
+2 WRITE !,"Printed on: "
SET Y=PSIVRUN
DO WD
WRITE !!,"Patient name",?40,"Order",?80,"Stop date",?105,"Provider",!
FOR Y=1:1:130
WRITE "-"
+3 SET WARD=WRD
WRITE !?50,"**** Ward: ",WRD," ****"
WRITE !
QUIT
QUERNL SET ZTIO=PSIVPR
SET ZTDESC="IV "_$SELECT($EXTRACT(PSIVEND)=9:"ACTIVE ORDER",1:"RENEWAL")_" LIST"
SET ZTRTN="DEQRNL^PSIVRNL"
FOR X="WRDE","WRDB","PSIVBEG","PSIVEND","PSIVSITE","PSIVSN","PSJSYSW0","PSJSYSU","PSJSYSP","PSJSYSP0"
SET ZTSAVE(X)=""
+1 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Queued."
GOTO QRNL
UT SET ^UTILITY("PSIV",$JOB,$SELECT($PIECE(VAIN(4),U,2)]"":$PIECE(VAIN(4),U,2),1:"Outpatient IV"),DFN,ON)=""
QUIT
CHK IF "DEPN"'[P(17)
IF $PIECE($GET(^PS(55,DFN,"IV",ON,2)),U,2)=PSIVSN
IF $SELECT($EXTRACT(PSIVEND)=9
DO PRNT
+1 QUIT
ENTACT DO NOW^%DTC
SET PSIVBEG=%
SET Y=9999999
GOTO EN1
CHK2 IF '$GET(SSNF)
WRITE VA("BID")," [",ON,"]"
SET SSNF=1
QUIT
