71 lines
3.7 KiB
Mathematica
71 lines
3.7 KiB
Mathematica
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
|