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

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)