source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVSUS.m@ 846

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

initial load of WorldVistAEHR

File size: 4.5 KB
RevLine 
[613]1PSIVSUS ;BIR/PR-SUSPENSE LIST OPTIONS ;16 DEC 97 / 1:40 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191.
5 ;
6CHK ;Entry for individual label suspense, check if labels may be suspended.
7 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
8 ;
9ALSUS ;See if labels are already suspended.
10 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
11 ;
12S1 ;Suspend labels.
13 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
14 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
15 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
16 K PSIVNOW Q
17 ;
18ENT ;Print labels from suspense
19 D ^PSIVXU I $D(XQUIT) K XQUIT Q
20 D EXPIR S X="T-1",%DT="T" D ^%DT S PSIVDEL=Y
21 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
22DEQSUS 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)
23 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
24Q L -^PS(55,"PSIVSUS",PSIVSN) K JJ,PSCT,PSIVDT,PSIVTTM,TOTAL,I,ON,PSIVDOSE,P16,PSIVDEL,PSIVNW,NODE
25Q1 D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
26 Q
27E2 G:"PDH"[$P($G(^PS(55,DFN,"IV",+ON,0)),U,17) E3
28 S PSIVWMFL=1 ;Var is use to store in PSIVID() ea ID prt on the label
29 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)
30E3 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)
31 I $D(PSIVID) NEW X F X=0:0 S X=$O(PSIVID(X)) Q:'X D
32 . S ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT,X)=""
33 K PSIVWMFL,PSIVID
34 Q
35 ;
36EN3 ;Will print a report of those labels on suspense
37 D ^PSIVXU I $D(XQUIT) K XQUIT Q
38 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
39 I PSIVPR=ION!(%=2) D DEQEN3
40 E S ZTIO=PSIVPR,(ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))="",ZTDESC="SUSPENSE LIST (IV)",ZTRTN="DEQEN3^PSIVSUS" D ^%ZTLOAD
41 K ON D ENIVKV^PSGSETU
42 Q
43DEQEN3 K DONE,PSIVFND D HDR1
44 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
45 .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)
46QEN3 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
47 Q
48PRNT 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)
49 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)
50 W !,VA("BID")," [",ON,"]" S SSNF=1,PSIV=0 D ENP3^PSIVRNL Q
51HDR ;
52 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR I $D(DUOUT)!$D(DTOUT) S DONE=1 Q
53HDR1 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 "-"
54 Q
55SETP S Y=$S($D(^PS(55,DFN,"IV",+ON,0)):^(0),1:"") F X=1:1:23 S P(X)=$P(Y,U,X)
56 Q
57EXPIR ;
58 D NOW^%DTC
59 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)
Note: See TracBrowser for help on using the repository browser.