source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVRD.m@ 691

PSIVRD ;BIR/PR,MLM-HANDLE QUICK RET/DES ENTRY ;29 SEP 97 / 11:17 AM

 ;;5.0; INPATIENT MEDICATIONS ;**38,58,88**;16 DEC 97

 ;        ;

 ; Reference to ^PS(55 is supported by DBIA 2191

 ;

EN ; Entry point to enter returns/destroyed items.

 D ^PSIVXU Q:$D(XQUIT)  F  D ENGETP^PSIV Q:DFN<0  D EN1

Q K ACTION,D,DFN,DIC,DIR,DRG,DRGI,DRGN,E,E1,HELP,I,I1,JJ,LABELS,MXMN,ON,ON55,ONCNT,P,PS,PSGDT,PSGID,PSGP,PSGLMT,PSGODDD,PSIVAC,PSIVC,PSIVNOL,PSIVNOW,PSIVON

 K PSIVPL,PSIVPR,PSIVSITE,PSIVUP,PSIVX,PSJORIFN,PSJORL,PSJHT,PSJPWT,PSJSYSL,PSJSYSU,PSJSYSW,PSJSYSW0,Q,UL80,VA,VADM,VAIN,VAERR,PSIVNU,PSIVOV1,PSIVOV2,PSIVSN,RDFLAG,RDWARD,X,XQUIT,Y

 Q

 ;

EN1 ;

 S PSIVBR="D PROCESS^PSIVRD" D ENCHS1^PSIV

 Q

EN1OLD ;

 ;S PSIVAC="RD" D ENNB^PSIVACT I P("PT")'="N" D GTORDRS Q

ORDNO ;

 F  R !!,"Enter the order number(s) to be processed: ",PSIVNU:DTIME Q:"^"[PSIVNU  D READ

 Q

 ;

READ ; Read order no.s, no profile.

 N DONE I '$T!(PSIVNU="^")!(PSIVNU="") S PSIVNU="" Q

 I PSIVNU["?" W !!,"Enter order number(s) separated by a comma e.g. 2,4,5,6.",! Q

 I PSIVNU[" " W $C(7),$C(7),"??",!! Q

 F I=1:1:$L(PSIVNU,",") S ON=$P(PSIVNU,",",I) D

 .I $L(ON)'>0 W $C(7),$C(7),"??",!! S DONE=1

 .F JJ=1:1:$L(ON) Q:$G(DONE)  I $A($E(ON,JJ))<48!($A($E(ON,JJ))>57) W !!,$C(7),$C(7),"Order ",ON," is invalid.",!! S DONE=1

 I '$G(DONE) F I=1:1:$L(PSIVNU,",") S ON=$P(PSIVNU,",",I) I '$D(^PS(55,DFN,"IV",+ON,0)) W !!,$C(7),$C(7),"Order number ",+ON," does not exist for this patient.",! S DONE=1

 I '$G(DONE) D NOW^%DTC S PSIVNOW=% F ONCNT=1:1:$L(PSIVNU,",") D  S ON=9999999999-$P(PSIVNU,",",ONCNT) D OV1

 .S X=$G(^PS(55,DFN,"IV",+ON,0)) I $P(X,U,3)<PSIVNOW,("AR"[$P(X,U,17)) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE

 Q

 ;**********************************************************

 ;* GTORDRS, ASK, OV subroutines are no longer use in 5.0. *

 ;**********************************************************

GTORDRS ;Needs PSIVBR (Branch point)

 S IOP="HOME" D ^%ZIS K %ZIS,IOP Q:P("PT")="N"

 D ^PSIVPRO Q:X="^"  I X]"" G OV

ASK Q:PS<1  W !!,"Choose 1-",PS,": " R X:DTIME S:'$T X="^" Q:"^"[X

 I X?1."?" S HELP="CHSE" D ^PSIVHLP D:X?2."?" H2^PSGON G ASK

 S PSGLMT=PS D ^PSGON G:'$D(X) ASK

OV ;

 W ! F PSIVOV1=1:1:PSGODDD F PSIVOV2=1:1:$L(PSGODDD(PSIVOV1),",")-1 S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2),ON=$S($D(^TMP("PSIV",$J,"AB",ON)):^(ON),$D(^TMP("PSIV",$J,"NB",ON)):^(ON),$D(^TMP("PSIV",$J,"XB",ON)):^(ON),1:"") Q:'ON  D OV1

 Q

OV1 ;

 S (ON,ON55,P("PON"))=9999999999-ON_"V" K PSIVNUM D GT55^PSIVORFB,ENNONUM^PSIVORV2(DFN,ON)

 D PROCESS1

 Q

 ;

PROCESS ;

 D FULL^VALM1

 S PSJORD=ON D ENNH^PSIVORV2(ON)

PROCESS1 ;

 I '$D(^PS(55,DFN,"IV",+ON,9)) W !!,$C(7),$C(7),"No labels have been dispensed for this order." N DIR S DIR(0)="E" D ^DIR Q

 I $P(^PS(55,DFN,"IV",+ON,2),U,2)'=PSIVSN W !!,"WARNING ",$C(7),$C(7),$C(7),"This order is in a different IV room",!," from the one in which you are entering returned/destroyed!" S E1=$P(^(2),U,2),E=PSIVSN

 D PAUSE^VALM1

 S PSIVLBTP=2,PSJMORE=0,RDFLAG="ON" D EN^VALM("PSJ LM IV RETURN LABELS")

 Q

 ;

 ;S RDFLAG="ON",X="Was this bottle RECYCLED or DESTROYED or CANCELLED ?^R^^RECYCLED,DESTROYED,CANCELLED" D ENQ^PSIV Q:X=U  I X["?" S HELP="RTDS" D ^PSIVHLP1 G PROCESS1

 ;W ! S Y=$E(X),PSIVC=$S(Y="R":2,Y="D":3,1:4)

 ;

WARD ;Get the ward to associate returns or destroyed with.

 I '$D(PSJIDLST) W !,"No labels are available" D PAUSE^VALM1 Q

 K DIC I $D(^DPT(DFN,.1)) S DIC("B")=^DPT(DFN,.1)

 S DIC("A")="Enter ward or ^OUTPATIENT: ",DIC(0)="AEQ",DIC=42,D="B" D IX^DIC G:X="^"!(X="") KILL I $P("^OUTPATIENT",X)="" W $P("^OUTPATIENT",X,2) S RDWARD=.5 G WARD1

 S:Y>0 RDWARD=+Y I Y<0 G WARD

 ;

WARD1 ;

 NEW PSIVCTD S PSIVCTD=""

 S PSJY=$$PROMPT^PSIVLBRP()

 Q:PSJY=""

 S PSIVNOL=0

 F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1=""  S PSIVNOL=PSIVNOL+1

 F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1=""  D

 . S PSJID=$G(PSJIDLST(PSJSEL1)) Q:PSJID=""

 . S PSJIDNO=$P(PSJID,"V",2) D NOW^%DTC

 . K DA,DR,DIE,DIC

 . S DA=PSJIDNO,DA(1)=DFN,DIE="^PS(55,"_DA(1)_",""IVBCMA"","

 . S DR="4////"_%_";5////"_$S(PSIVC=2:"RC",PSIVC=3:"DT",1:"CA") D ^DIE

 . K DA,DR,DIE,DIC

 S LABELS=PSIVNOL,ACTION=$S(PSIVC=2:2,PSIVC=3:3,1:4) D ^PSIVLTR,^PSIVSTAT W "...Done."

 Q

NRD ;Ask number of bottles/bags

 Q

 ;NO LONGER USE

 S MXMN=$P(^PS(55,DFN,"IV",+ON,9),U,3)

NRD1 ;

 Q

 ;NO LONGER USE

 R !,"Number of bottles: ",X:DTIME W:'$T $C(7) S:'$T X="^" G:"^"[X KILL I X?1."?" S HELP="REDT" D ^PSIVHLP G NRD1

 I $S($E(X,$E(X)="-"+1,$L(X))'?1.N:1,X<-50:1,X>MXMN:1,1:'X) W $C(7),"  ??" G NRD1

 ;

 S PSIVNOL=+X,LABELS=PSIVNOL,ACTION=$S(PSIVC=2:2,PSIVC=3:3,1:4) D ^PSIVLTR,^PSIVSTAT W "...Done."

 ;

KILL ;

 Q

 ;NO LONGER USE

 W:"^"[X $C(7),"NO ACTION TAKEN" K D,LABELS,MXMN,X,Y,PSIVNOL,HELP,DIC,RDFLAG,PSIVC

 S VALMBCK="R"

 Q