source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSORD1.m@ 846

Last change on this file since 846 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1LRSORD1 ;SLC/RWF/DALISC/JBM- CRITICAL VALUE REPORT ; 8/30/87 17:25 ;
2 ;;5.2;LAB SERVICE;**344**;Sep 27, 1994
3EN ;
4BUILD ;
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
12LRIDT ;
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
16LOOK ;
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:'$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=$S($D(^DPT(DFN,.1)):^(.1),1:LRLLOC)
34 .I LRLCS Q:'$D(LRLCS(LRLOC))
35 .S LRDAT=$P(^LR(LRDFN,"CH",LRIDT,0),U),LRSPEC=$P(^(0),U,5)
36 .S LRSUB1=$S(LRSRT="P":PNM_SSN,1:LRLOC)
37 .S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_SSN)
38 .S LRSUB3=$S(LRSRT="P":LRLOC,1:LRDAT)
39 .S LRAN=$P(L0,U,6)
40 .K %DT S X=$P(L0,U),%DT="XT" D ^%DT,DD^LRX S LRSPDAT=Y
41 .S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_SSN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC
42 .S I=0
43 .F S I=$O(T(I)) Q:LREND!(I<1) D
44 ..S LRTX=$O(^LAB(60,"C","CH;"_I_";1",0))
45 ..I LRTX>0 D
46 ...S LRTST=$P(^LAB(60,LRTX,0),U),LRTVAL=$P(T(I),U)
47 ...S LRCRTFLG=$P(T(I),U,2)
48 ...I $G(LRFLAG) D GET63
49 ...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:"")
50 .S C=0
51 .F S C=$O(^LR(LRDFN,"CH",LRIDT,1,C)) Q:'C D
52 ..S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)=^LR(LRDFN,"CH",LRIDT,1,C,0)
53 Q
54 ;
55GET63 ; get ranges from file 63 (T(I)) if they are stored there
56 S PC5=$P(T(I),U,5)
57 S LR63RLO=$P(PC5,"!",2)
58 S LR63RHI=$P(PC5,"!",3)
59 S LR63CLO=$P(PC5,"!",4)
60 S LR63CHI=$P(PC5,"!",5)
61 S LR63TLO=$P(PC5,"!",11)
62 S LR63THI=$P(PC5,"!",12)
63 S LR63DAT=U_LR63RLO_U_LR63RHI_U_LR63CLO_U_LR63CHI_U_LR63TLO_U_LR63THI
64 Q
Note: See TracBrowser for help on using the repository browser.