65 lines
2.2 KiB
Mathematica
65 lines
2.2 KiB
Mathematica
LRSORD1 ;SLC/RWF/DALISC/JBM- CRITICAL VALUE REPORT ; 8/30/87 17:25 ;
|
|
;;5.2;LAB SERVICE;**344**;Sep 27, 1994
|
|
EN ;
|
|
BUILD ;
|
|
S LRPDT=LREDT-.000001
|
|
F S LRPDT=$O(^LRO(69,LRPDT)) Q:('LRPDT)!(LRPDT>LRSDT)!(LREND=1) D
|
|
.S LRLLOC=""
|
|
.F S LRLLOC=$O(^LRO(69,LRPDT,1,"AN",LRLLOC)) Q:LRLLOC="" D
|
|
..S LRDFN=0
|
|
..F S LRDFN=$O(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN)) Q:'LRDFN D LRIDT
|
|
Q
|
|
LRIDT ;
|
|
S LRIDT=0,LRSPEC=0
|
|
F S LRIDT=$O(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN,LRIDT)) Q:'LRIDT D LOOK
|
|
Q
|
|
LOOK ;
|
|
N LR63RLO,LR63RHI,LR63CLO,LR63CHI,LR63TLO,LR63THI,LR63DAT,PC5,LRFLAG
|
|
K T S L0=$G(^LR(LRDFN,"CH",LRIDT,0)) Q:'$L(L0)
|
|
S LRSPEC=$P(L0,"^",5)
|
|
I LRAA S LRAAA=$P($P(L0,U,6)," ") Q:'$D(LRAA(LRAAA))#2
|
|
S T=0,I=1
|
|
F S I=$O(^LR(LRDFN,"CH",LRIDT,I)) Q:LREND!(I<1) D
|
|
.I $P(^LR(LRDFN,"CH",LRIDT,I),U,2)'="" D
|
|
..S T=T+1,T(I)=^LR(LRDFN,"CH",LRIDT,I)
|
|
..I $G(LRFLAG)="" D
|
|
...I $G(^LR(LRDFN,"CH",LRIDT,"NPC"))>1,$P(T(I),U,5,12)'="" S LRFLAG=1 Q
|
|
...S LRFLAG=0
|
|
I T D
|
|
.S X=^LR(LRDFN,0)
|
|
.S LRDPF=$P(X,U,2),DFN=$P(X,U,3)
|
|
.I LRPTS Q:'$D(LRPTS(DFN))
|
|
.D PT^LRX
|
|
.S LRLOC=$S($D(^DPT(DFN,.1)):^(.1),1:LRLLOC)
|
|
.I LRLCS Q:'$D(LRLCS(LRLOC))
|
|
.S LRDAT=$P(^LR(LRDFN,"CH",LRIDT,0),U),LRSPEC=$P(^(0),U,5)
|
|
.S LRSUB1=$S(LRSRT="P":PNM_SSN,1:LRLOC)
|
|
.S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_SSN)
|
|
.S LRSUB3=$S(LRSRT="P":LRLOC,1:LRDAT)
|
|
.S LRAN=$P(L0,U,6)
|
|
.K %DT S X=$P(L0,U),%DT="XT" D ^%DT,DD^LRX S LRSPDAT=Y
|
|
.S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_SSN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC
|
|
.S I=0
|
|
.F S I=$O(T(I)) Q:LREND!(I<1) D
|
|
..S LRTX=$O(^LAB(60,"C","CH;"_I_";1",0))
|
|
..I LRTX>0 D
|
|
...S LRTST=$P(^LAB(60,LRTX,0),U),LRTVAL=$P(T(I),U)
|
|
...S LRCRTFLG=$P(T(I),U,2)
|
|
...I $G(LRFLAG) D GET63
|
|
...S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"TST",I)=LRTST_U_LRTVAL_U_LRCRTFLG_U_LRSPEC_U_LRTX_U_$G(LRFLAG)_$S($G(LRFLAG):LR63DAT,1:"")
|
|
.S C=0
|
|
.F S C=$O(^LR(LRDFN,"CH",LRIDT,1,C)) Q:'C D
|
|
..S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)=^LR(LRDFN,"CH",LRIDT,1,C,0)
|
|
Q
|
|
;
|
|
GET63 ; get ranges from file 63 (T(I)) if they are stored there
|
|
S PC5=$P(T(I),U,5)
|
|
S LR63RLO=$P(PC5,"!",2)
|
|
S LR63RHI=$P(PC5,"!",3)
|
|
S LR63CLO=$P(PC5,"!",4)
|
|
S LR63CHI=$P(PC5,"!",5)
|
|
S LR63TLO=$P(PC5,"!",11)
|
|
S LR63THI=$P(PC5,"!",12)
|
|
S LR63DAT=U_LR63RLO_U_LR63RHI_U_LR63CLO_U_LR63CHI_U_LR63TLO_U_LR63THI
|
|
Q
|