source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSORC1.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1LRSORC1 ;SLC/RWF/DALISC/JBM - CRITICAL VALUE REPORT ; 8/30/87 17:25 ;
2 ;;5.2;LAB SERVICE;**153,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:'$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 ;
56GET63 ; 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
Note: See TracBrowser for help on using the repository browser.