| 1 | LRSORC1 ;SLC/RWF/DALISC/JBM - CRITICAL VALUE REPORT ; 8/30/87 17:25 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**153,344**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | BUILD ;
|
|---|
| 5 | S LRPDT=LREDT-.000001
|
|---|
| 6 | F S LRPDT=$O(^LRO(69,LRPDT)) Q:('LRPDT)!(LRPDT>LRSDT)!(LREND=1) D
|
|---|
| 7 | .S LRLLOC=""
|
|---|
| 8 | .F S LRLLOC=$O(^LRO(69,LRPDT,1,"AN",LRLLOC)) Q:LRLLOC="" D
|
|---|
| 9 | ..S LRDFN=0
|
|---|
| 10 | ..F S LRDFN=$O(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN)) Q:'LRDFN D LRIDT
|
|---|
| 11 | Q
|
|---|
| 12 | LRIDT ;
|
|---|
| 13 | S LRIDT=0,LRSPEC=0
|
|---|
| 14 | F S LRIDT=$O(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN,LRIDT)) Q:'LRIDT D LOOK
|
|---|
| 15 | Q
|
|---|
| 16 | LOOK ;
|
|---|
| 17 | N LR63RLO,LR63RHI,LR63CLO,LR63CHI,LR63TLO,LR63THI,LR63DAT,PC5,LRFLAG
|
|---|
| 18 | K T S L0=$G(^LR(LRDFN,"CH",LRIDT,0)) Q:'$L(L0)
|
|---|
| 19 | S LRSPEC=$P(L0,"^",5)
|
|---|
| 20 | I LRAA S LRAAA=$P($P(L0,U,6)," ") Q:'$L(LRAAA) Q:'$D(LRAA(LRAAA))#2
|
|---|
| 21 | S T=0,I=1
|
|---|
| 22 | F S I=$O(^LR(LRDFN,"CH",LRIDT,I)) Q:LREND!(I<1) D
|
|---|
| 23 | .I $P(^LR(LRDFN,"CH",LRIDT,I),U,2)["*" D
|
|---|
| 24 | ..S T=T+1,T(I)=^LR(LRDFN,"CH",LRIDT,I)
|
|---|
| 25 | ..I $G(LRFLAG)="" D
|
|---|
| 26 | ...I $G(^LR(LRDFN,"CH",LRIDT,"NPC"))>1,$P(T(I),U,5,12)'="" S LRFLAG=1 Q
|
|---|
| 27 | ...S LRFLAG=0
|
|---|
| 28 | I T D
|
|---|
| 29 | .S X=^LR(LRDFN,0)
|
|---|
| 30 | .S LRDPF=$P(X,U,2),DFN=$P(X,U,3)
|
|---|
| 31 | .I LRPTS Q:'$D(LRPTS(DFN))
|
|---|
| 32 | .D PT^LRX
|
|---|
| 33 | .S LRLOC=LRLLOC
|
|---|
| 34 | .;S LRLOC=$S($D(^DPT(DFN,.1)):^(.1),1:LRLLOC)
|
|---|
| 35 | .I LRLCS Q:'$D(LRLCS(LRLLOC))
|
|---|
| 36 | .S LRDAT=$P(^LR(LRDFN,"CH",LRIDT,0),U),LRSPEC=$P(^(0),U,5)
|
|---|
| 37 | .S LRSUB1=$S(LRSRT="P":PNM_SSN,1:LRLOC)
|
|---|
| 38 | .S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_SSN)
|
|---|
| 39 | .S LRSUB3=$S(LRSRT="P":LRLOC,1:LRDAT)
|
|---|
| 40 | .S LRAN=$P(L0,U,6)
|
|---|
| 41 | .K %DT S X=$P(L0,U),%DT="XT" D ^%DT,DD^LRX S LRSPDAT=Y
|
|---|
| 42 | .S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_SSN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC
|
|---|
| 43 | .S I=0
|
|---|
| 44 | .F S I=$O(T(I)) Q:LREND!(I<1) D
|
|---|
| 45 | ..S LRTX=$O(^LAB(60,"C","CH;"_I_";1",0))
|
|---|
| 46 | ..I LRTX>0 D
|
|---|
| 47 | ...S LRTST=$P(^LAB(60,LRTX,0),U),LRTVAL=$P(T(I),U)
|
|---|
| 48 | ...S LRCRTFLG=$P(T(I),U,2)
|
|---|
| 49 | ...I $G(LRFLAG) D GET63
|
|---|
| 50 | ...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:"")
|
|---|
| 51 | .S C=0
|
|---|
| 52 | .F S C=$O(^LR(LRDFN,"CH",LRIDT,1,C)) Q:'C D
|
|---|
| 53 | ..S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)=^LR(LRDFN,"CH",LRIDT,1,C,0)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | GET63 ; get ranges from file 63 (T(I)) if they are stored there
|
|---|
| 57 | S PC5=$P(T(I),U,5)
|
|---|
| 58 | S LR63RLO=$P(PC5,"!",2)
|
|---|
| 59 | S LR63RHI=$P(PC5,"!",3)
|
|---|
| 60 | S LR63CLO=$P(PC5,"!",4)
|
|---|
| 61 | S LR63CHI=$P(PC5,"!",5)
|
|---|
| 62 | S LR63TLO=$P(PC5,"!",11)
|
|---|
| 63 | S LR63THI=$P(PC5,"!",12)
|
|---|
| 64 | S LR63DAT=U_LR63RLO_U_LR63RHI_U_LR63CLO_U_LR63CHI_U_LR63TLO_U_LR63THI
|
|---|
| 65 | Q
|
|---|
