PSIVSUS ;BIR/PR-SUSPENSE LIST OPTIONS ;16 DEC 97 / 1:40 PM
;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
;
CHK ;Entry for individual label suspense, check if labels may be suspended.
K JJ D NOW^%DTC S PSIVNOW=% I "EDPHN"[$P(^PS(55,DFN,"IV",+ON,0),U,17) F JJ="DISCONTINUED,","EXPIRED,","NON-VERIFIED,","or ON HOLD" W:JJ["DISC" $C(7),$C(7),!!,"YOU MAY NOT SUSPEND LABELS FOR ORDERS:" W:JJ["DISC" ?$X+1,JJ W:JJ'["DISC" !?39,JJ
;
ALSUS ;See if labels are already suspended.
Q:$D(JJ) I $D(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) D C^PSIVORE2 W !!,"There are already ",SNM," ",$S(SNM>1:"LABELS",1:"LABEL")," suspended for this order." K SNM,DAT
;
S1 ;Suspend labels.
R !!,"Number of labels to suspend: ",X:DTIME Q:'$T!("^"[X) S:X["?" HELP="SUSL" D:X["?" ^PSIVHLP G:X["?" S1 K:+X'=X!(X>10)!(X<1)!(X?.E1"."1N.N) X W:'$D(X) $C(7),$C(7),"??" G:'$D(X) S1
I $D(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)) W $C(7),!," ... NO labels suspended! Wait 15 seconds and try again." D NOW^%DTC S PSIVNOW=% G S1
S ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)=+X_"^^"_$P(^PS(55,DFN,"IV",+ON,0),U,16),$P(^(0),U,16)=$P(^PS(55,DFN,"IV",+ON,0),U,16)+X W " ..... ",+X," Label"_$S(+X>1:"s",1:"")_" suspended !" S ACTION=5,PSIVNOL=+X,TRACK=1 D ^PSIVLTR
K PSIVNOW Q
;
ENT ;Print labels from suspense
D ^PSIVXU I $D(XQUIT) K XQUIT Q
D EXPIR S X="T-1",%DT="T" D ^%DT S PSIVDEL=Y
I PSIVPL'=ION S ZTDESC="PRINT LABELS FROM SUSPENSE (IV)",ZTRTN="DEQSUS^PSIVSUS" S (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSIVDEL"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))="",ZTIO=PSIVPL D ^%ZTLOAD W:$D(ZTSK) !,"Queued." Q
DEQSUS L +^PS(55,"PSIVSUS",PSIVSN):1 G:'$T Q D NOW^%DTC S Y=%,PSIVNW=Y,X="A" F I=0:0 S X=$O(^PS(55,"PSIVSUS",PSIVSN,X)) Q:X="" I $E(X,2,999)<PSIVDEL K ^PS(55,"PSIVSUS",PSIVSN,X)
F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) Q:'ON F SDT=0:0 S SDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)) Q:'SDT D E2
Q L -^PS(55,"PSIVSUS",PSIVSN) K JJ,PSCT,PSIVDT,PSIVTTM,TOTAL,I,ON,PSIVDOSE,P16,PSIVDEL,PSIVNW,NODE
Q1 D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
Q
E2 G:"PDH"[$P($G(^PS(55,DFN,"IV",+ON,0)),U,17) E3
S PSIVWMFL=1 ;Var is use to store in PSIVID() ea ID prt on the label
S PSIVNOL=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT),P16=$P(^(SDT),U,3),PSIVDOSE=$P(^(SDT),U,2),P(4)=$P(^PS(55,DFN,"IV",+ON,0),U,4),ACTION=1,TRACK=3 D ^PSIVLTR D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4)
E3 S ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT)=^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT) K ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
I $D(PSIVID) NEW X F X=0:0 S X=$O(PSIVID(X)) Q:'X D
. S ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT,X)=""
K PSIVWMFL,PSIVID
Q
;
EN3 ;Will print a report of those labels on suspense
D ^PSIVXU I $D(XQUIT) K XQUIT Q
D EXPIR I PSIVPR'=ION R !!,"Send report to a printer" S %=2 D YN^DICN Q:%=-1 I %=0 S HELP="SUSRPT" D ^PSIVHLP1 G EN3
I PSIVPR=ION!(%=2) D DEQEN3
E S ZTIO=PSIVPR,(ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))="",ZTDESC="SUSPENSE LIST (IV)",ZTRTN="DEQEN3^PSIVSUS" D ^%ZTLOAD
K ON D ENIVKV^PSGSETU
Q
DEQEN3 K DONE,PSIVFND D HDR1
F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN!$G(DONE) D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) Q:'ON!$G(DONE) D
.D SETP F PSIVDT=0:0 S PSIVDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)) Q:'PSIVDT!$G(DONE) D PRNT:"DPN"'[P(17)
QEN3 W:'$D(PSIVFND) !,"No Data Found" W:'$D(PSIVPR)&($Y) @IOF K D,DFN,DONE,I,NODE,ON,P,PSIV,PSIVDT,PSIVFND,SDT,VAERR,Z D Q1
Q
PRNT D:$Y+8>IOSL HDR Q:$G(DONE) S Y=PSIVDT X ^DD("DD") S PSIVFND=1,NODE=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)_"^"_$P(Y,"@")_" "_$P(Y,"@",2)
D ENIV^PSJAC W !,VADM(1)," (",$S(VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",$J(+NODE_" label"_$S(+NODE>1:"s",1:"")_" "_$P(NODE,U,2),IOM-1-$X)
W !,VA("BID")," [",ON,"]" S SSNF=1,PSIV=0 D ENP3^PSIVRNL Q
HDR ;
I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR I $D(DUOUT)!$D(DTOUT) S DONE=1 Q
HDR1 W:$Y @IOF W !!,"Suspense list for: " D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!,"Patient name",?30,"Order",?IOM-11,"Suspended",! F X=1:1:IOM-1 W "-"
Q
SETP S Y=$S($D(^PS(55,DFN,"IV",+ON,0)):^(0),1:"") F X=1:1:23 S P(X)=$P(Y,U,X)
Q
EXPIR ;
D NOW^%DTC
F Y=0:0 S Y=$O(^PS(55,"PSIVSUS",PSIVSN,Y)) Q:'Y F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,Y,+ON)) Q:'ON S X=$S($D(^PS(55,Y,"IV",+ON,0)):^(0),1:"") I $P(X,U,2)'=$P(X,U,3),$P(X,U,3)'>%!("D"[$P(X,U,17)) K ^PS(55,"PSIVSUS",PSIVSN,Y,+ON)
PSIVSUS ;BIR/PR-SUSPENSE LIST OPTIONS ;16 DEC 97 / 1:40 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ;
CHK ;Entry for individual label suspense, check if labels may be suspended.
+1 KILL JJ
DO NOW^%DTC
SET PSIVNOW=%
IF "EDPHN"[$PIECE(^PS(55,DFN,"IV",+ON,0),U,17)
FOR JJ="DISCONTINUED,","EXPIRED,","NON-VERIFIED,","or ON HOLD"
IF JJ["DISC"
WRITE $CHAR(7),$CHAR(7),!!,"YOU MAY NOT SUSPEND LABELS FOR ORDERS:"
IF JJ["DISC"
WRITE ?$X+1,JJ
IF JJ'["DISC"
WRITE !?39,JJ
+2 ;
ALSUS ;See if labels are already suspended.
+1 IF $DATA(JJ)
QUIT
IF $DATA(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
DO C^PSIVORE2
WRITE !!,"There are already ",SNM," ",$SELECT(SNM>1:"LABELS",1:"LABEL")," suspended for this order."
KILL SNM,DAT
+2 ;
S1 ;Suspend labels.
+1 READ !!,"Number of labels to suspend: ",X:DTIME
IF '$TEST!("^"[X)
QUIT
IF X["?"
SET HELP="SUSL"
IF X["?"
DO ^PSIVHLP
IF X["?"
GOTO S1
IF +X'=X!(X>10)!(X<1)!(X?.E1"."1N.N)
KILL X
IF '$DATA(X)
WRITE $CHAR(7),$CHAR(7),"??"
IF '$DATA(X)
GOTO S1
+2 IF $DATA(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW))
WRITE $CHAR(7),!," ... NO labels suspended! Wait 15 seconds and try again."
DO NOW^%DTC
SET PSIVNOW=%
GOTO S1
+3 SET ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)=+X_"^^"_$PIECE(^PS(55,DFN,"IV",+ON,0),U,16)
SET $PIECE(^(0),U,16)=$PIECE(^PS(55,DFN,"IV",+ON,0),U,16)+X
WRITE " ..... ",+X," Label"_$SELECT(+X>1:"s",1:"")_" suspended !"
SET ACTION=5
SET PSIVNOL=+X
SET TRACK=1
DO ^PSIVLTR
+4 KILL PSIVNOW
QUIT
+5 ;
ENT ;Print labels from suspense
+1 DO ^PSIVXU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+2 DO EXPIR
SET X="T-1"
SET %DT="T"
DO ^%DT
SET PSIVDEL=Y
+3 IF PSIVPL'=ION
SET ZTDESC="PRINT LABELS FROM SUSPENSE (IV)"
SET ZTRTN="DEQSUS^PSIVSUS"
SET (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSIVDEL"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))=""
SET ZTIO=PSIVPL
DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Queued."
QUIT
DEQSUS LOCK +^PS(55,"PSIVSUS",PSIVSN):1
IF '$TEST
GOTO Q
DO NOW^%DTC
SET Y=%
SET PSIVNW=Y
SET X="A"
FOR I=0:0
SET X=$ORDER(^PS(55,"PSIVSUS",PSIVSN,X))
IF X=""
QUIT
IF $EXTRACT(X,2,999)<PSIVDEL
KILL ^PS(55,"PSIVSUS",PSIVSN,X)
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN))
IF 'DFN
QUIT
DO ENIV^PSJAC
FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
IF 'ON
QUIT
FOR SDT=0:0
SET SDT=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT))
IF 'SDT
QUIT
DO E2
Q LOCK -^PS(55,"PSIVSUS",PSIVSN)
KILL JJ,PSCT,PSIVDT,PSIVTTM,TOTAL,I,ON,PSIVDOSE,P16,PSIVDEL,PSIVNW,NODE
Q1 DO ENIVKV^PSGSETU
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
E2 IF "PDH"[$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),U,17)
GOTO E3
+1 ;Var is use to store in PSIVID() ea ID prt on the label
SET PSIVWMFL=1
+2 SET PSIVNOL=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
SET P16=$PIECE(^(SDT),U,3)
SET PSIVDOSE=$PIECE(^(SDT),U,2)
SET P(4)=$PIECE(^PS(55,DFN,"IV",+ON,0),U,4)
SET ACTION=1
SET TRACK=3
DO ^PSIVLTR
IF P(4)="H"
DO ^PSIVHYPL
IF "APSC"[P(4)
DO ^PSIVLABL
E3 SET ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT)=^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
KILL ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
+1 IF $DATA(PSIVID)
NEW X
FOR X=0:0
SET X=$ORDER(PSIVID(X))
IF 'X
QUIT
Begin DoDot:1
+2 SET ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT,X)=""
End DoDot:1
+3 KILL PSIVWMFL,PSIVID
+4 QUIT
+5 ;
EN3 ;Will print a report of those labels on suspense
+1 DO ^PSIVXU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+2 DO EXPIR
IF PSIVPR'=ION
READ !!,"Send report to a printer"
SET %=2
DO YN^DICN
IF %=-1
QUIT
IF %=0
SET HELP="SUSRPT"
DO ^PSIVHLP1
GOTO EN3
+3 IF PSIVPR=ION!(%=2)
DO DEQEN3
+4 IF '$TEST
SET ZTIO=PSIVPR
SET (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))=""
SET ZTDESC="SUSPENSE LIST (IV)"
SET ZTRTN="DEQEN3^PSIVSUS"
DO ^%ZTLOAD
+5 KILL ON
DO ENIVKV^PSGSETU
+6 QUIT
DEQEN3 KILL DONE,PSIVFND
DO HDR1
+1 FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN))
IF 'DFN!$GET(DONE)
QUIT
DO ENIV^PSJAC
FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
IF 'ON!$GET(DONE)
QUIT
Begin DoDot:1
+2 DO SETP
FOR PSIVDT=0:0
SET PSIVDT=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT))
IF 'PSIVDT!$GET(DONE)
QUIT
IF "DPN"'[P(17)
DO PRNT
End DoDot:1
QEN3 IF '$DATA(PSIVFND)
WRITE !,"No Data Found"
IF '$DATA(PSIVPR)&($Y)
WRITE @IOF
KILL D,DFN,DONE,I,NODE,ON,P,PSIV,PSIVDT,PSIVFND,SDT,VAERR,Z
DO Q1
+1 QUIT
PRNT IF $Y+8>IOSL
DO HDR
IF $GET(DONE)
QUIT
SET Y=PSIVDT
XECUTE ^DD("DD")
SET PSIVFND=1
SET NODE=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)_"^"_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
+1 DO ENIV^PSJAC
WRITE !,VADM(1)," (",$SELECT(VAIN(4):$PIECE(VAIN(4),U,2),1:"Outpatient IV"),")",$JUSTIFY(+NODE_" label"_$SELECT(+NODE>1:"s",1:"")_" "_$PIECE(NODE,U,2),IOM-1-$X)
+2 WRITE !,VA("BID")," [",ON,"]"
SET SSNF=1
SET PSIV=0
DO ENP3^PSIVRNL
QUIT
HDR ;
+1 IF $EXTRACT(IOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
SET DONE=1
QUIT
HDR1 IF $Y
WRITE @IOF
WRITE !!,"Suspense list for: "
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2),!,"Patient name",?30,"Order",?IOM-11,"Suspended",!
FOR X=1:1:IOM-1
WRITE "-"
+1 QUIT
SETP SET Y=$SELECT($DATA(^PS(55,DFN,"IV",+ON,0)):^(0),1:"")
FOR X=1:1:23
SET P(X)=$PIECE(Y,U,X)
+1 QUIT
EXPIR ;
+1 DO NOW^%DTC
+2 FOR Y=0:0
SET Y=$ORDER(^PS(55,"PSIVSUS",PSIVSN,Y))
IF 'Y
QUIT
FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,Y,+ON))
IF 'ON
QUIT
SET X=$SELECT($DATA(^PS(55,Y,"IV",+ON,0)):^(0),1:"")
IF $PIECE(X,U,2)'=$PIECE(X,U,3)
IF $PIECE(X,U,3)'>%!("D"[$PIECE(X,U,17))
KILL ^PS(55,"PSIVSUS",PSIVSN,Y,+ON)
