LRWU ;SLC/RWF/MILW/J - UTILITY FUNTIONS ; 12/28/88 11:04 ; ;;5.2;LAB SERVICE;**42,138,153**;Sep 27, 1994 Z ;;set up 0th nodes for globals I '$D(@(LRZO_"0)")) S ^(0)="^"_LRZ1_"^^" S LRZI1=$S($P(@(LRZO_"0)"),"^",3)>LRZ3:$P(^(0),"^",3),1:LRZ3),LRZI2=$P(^(0),"^",4)+1,$P(^(0),"^",3,4)=LRZI1_"^"_LRZI2 I $D(LRZB) S B="B",@(LRZO_"B,LRZB,LRZ3)")="" K LRZO,LRZ1,LRZ3,LRZI1,LRZI2 Q LOC ;get pt. location, called by LRPDA1 I $G(LRORDRR)="R" D Q . S LRCAPLOC="Z",LRLLOC=$P(LRRSITE("RSITE"),U,2),(LROLLOC,LRTREA)="" N % I +LRDPF=LRDPF S LRDPF=LRDPF_^DIC(LRDPF,0,"GL") S LREND=0,LRCAPLOC="Z" I $D(LRDPF),+$G(LRDPF)=2,$G(DFN),$D(@("^"_$S(LRDPF["^":$P(LRDPF,"^",2),1:"DPT(")_DFN_",.1)")) S LRLLOC=^(.1) D DPT G ASK I $D(^LR(LRDFN,.1)) S LRLLOC=^(.1) G ASK S LRLLOC="UNKNOWN" ASK W !,"PATIENT LOCATION: ",LRLLOC,$S(LRLLOC]"":"// ",1:"") R X:DTIME G QUIT:'$T,QUIT:X[U I $L(X)>30!(X'?.ANP) W " Enter 2 - 30 alpha-numeric name" G LOC K DIC S DIC("S")="I '$G(^(""OOS""))" S LROLLOC="",DIC=44,DIC(0)="EMOQZ" S:X="" X=LRLLOC D ^DIC K DIC G LOC:X["?" S:Y>0 LROLLOC=+Y,LRLLOC=$P(Y(0),U,2),LRCAPLOC=$S($L($P(Y(0),U,3)):$P(Y(0),U,3),1:LRCAPLOC) I $L(LRLLOC) S ^LR(LRDFN,.1)=LRLLOC S:'$L(LRLLOC) LRLLOC="NO ABRV" S ^LR(LRDFN,.092)=LRCAPLOC INACT K LRIA,LRRA I $D(^SC(+Y,"I")) S LRIA=+^("I"),LRRA=$P(^("I"),U,2) I $S('$D(LRIA):0,'LRIA:0,LRIA>DT:0,LRRA'>DT&(LRRA):0,1:1) W $C(7)," Location is inactive, Not allowed." G LOC I Y<0,('$D(LRLABKY)!($P(^LAB(69.9,1,1),"^",8))) W " You must select a standard location." G LOC I Y<0 W !,?7,"THAT MATCHES NO STANDARD LOCATION,",!,?12,"ARE YOU SURE" S %=2 D YN^DICN G LOC:%'=1 S LRLLOC=X,^LR(LRDFN,.1)=LRLLOC,^(.092)="Z" K DIC,LRIA,LRRA,% Q QUIT S LREND=1 K DIC,LRIA,LRRE,% Q DATE ; K DTOUT,DUOUT S LREND=0 W !,$S($D(%DT("A")):%DT("A"),1:"DATE: "),$S($D(%DT("B")):%DT("B"),1:"TODAY"),"//" R X:DTIME S:X="^" DUOUT=1 S:'$T X="^",DTOUT=1 I $D(DUOUT)!($D(DTOUT)) S LREND=1,Y=-1 Q S:X="" X=$S($D(%DT("B")):%DT("B"),1:"T") S:$D(%DT)[0 %DT="E" S:%DT["A" %DT=$P(%DT,"A",1)_$P(%DT,"A",2) S:%DT'["E" %DT="E"_%DT D ^%DT G DATE:X="?"!(Y<1) K %DT Q ADATE ; K %DT S %DT("A")="Accession Date: ",%DT="EP" D DATE I $D(LRAA)#2,$D(^LRO(68,LRAA,0)) S %=$P(^LRO(68,LRAA,0),U,3),Y=$S("D"[%:Y,%="Y":$E(Y,1,3)_"0000","M"[%:$E(Y,1,5)_"00","Q"[%:$E(Y,1,3)_"0000"+(($E(Y,4,5)-1)\3*300+100),1:Y) S LRAD=Y,LREND=(Y<1) Q Q LOCA ; K DIC S LRLLOC="" R !,"Select HOSPITAL LOCATION NAME: ",X:DTIME S:'$L(X) X=U G LOCE:'$T!(X[U),LOCHELP:($L(X)>20)!(X'?.ANP)!(X="") S LRLLOC=X,DIC=44,DIC(0)="EMOQ",DIC("S")="I '$G(^(""OOS""))" D ^DIC K DIC I Y'<1 S LROLLOC=+Y,LRLLOC=$S($L($P(^SC(+Y,0),U,2)):$P(^(0),U,2),1:$P(^(0),U)) G LOCHELP:X["?"!(X="") I Y<0 W !,?7,"THAT MATCHES NO STANDARD LOCATION,",!,?12,"ARE YOU SURE" S %=2 D YN^DICN G LOCA:%'=1 LOCE K DIC Q LOCHELP W !,"Enter a location of 1 to 20 characters." G LOCA DPT ; Q:'$D(LRLLOC) K DIC S X=LRLLOC,DIC(0)="XM",DIC=42 D ^DIC K DIC I Y<1 Q I $D(^DIC(42,+Y,44)) S X=$P(^(44),U) I X,$D(^SC(X,0))#2,'$G(^("OOS")) D . S LRLLOC=$S($L($P(^SC(X,0),U,2)):$P(^(0),U,2),1:$P(^(0),U)),LROLLOC=X S:'$G(LRTREA) LRTREA=$P(^(0),U,20) Q IO ;outputs ZTRTN D IOX K ZTRTN,ZTSAVE,IO("Q") D ^%ZISC Q IOX S:'$D(%ZIS) %ZIS="Q" D ^%ZIS I POP S LREND=1 Q I $D(IO("Q")) K IO("Q") S ZTSAVE("L*")="" D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED" K ZTSK,ZTIO Q D @ZTRTN Q A ; S X1=$A(X)_"." F I1=2:1:$L(X) S X1=X1_$A(X,I1) S X1=+X1 Q COLTY ;N DIR("A"),DIR(0) I $G(LRORDRR)="R" S LRLWC="R" I $G(LRLWC)="R" Q S DIR("B")=$S($D(LRLWC)=1:LRLWC,1:"SP") S LREND=0,DIR("A")="Specimen collected how ? ",DIR(0)="S^LC:LAB COLLECT(INPATIENTS-MORN. DRAW);SP:SEND PATIENT;WC:WARD COLLECT" S:$P($G(^LAB(69.9,1,7,DUZ(2),0)),U,6) DIR(0)=DIR(0)_";I:Immed COLLECT" D ^DIR S:X="^"!($D(DIRUT))!($D(DTOUT)) LREND=1 Q:LREND S LRLWC=Y Q