- LRSORC1 ;SLC/RWF/DALISC/JBM - CRITICAL VALUE REPORT ;JUL 06, 2010 3:14 PM;
- ;;5.2;LAB SERVICE;**153,344,1027**;NOV 01, 1997
- 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:'$L(LRAAA) 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=LRLLOC
- .;S LRLOC=$S($D(^DPT(DFN,.1)):^(.1),1:LRLLOC)
- .I LRLCS Q:'$D(LRLCS(LRLLOC))
- .S LRDAT=$P(^LR(LRDFN,"CH",LRIDT,0),U),LRSPEC=$P(^(0),U,5)
- .; S LRSUB1=$S(LRSRT="P":PNM_SSN,1:LRLOC)
- .S LRSUB1=$S(LRSRT="P":PNM_HRCN,1:LRLOC) ;IHS/ANMC/CLS 08/18/96
- .; S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_SSN)
- .S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_HRCN) ;IHS/ANMC/CLS 08/18/96
- .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 ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_HRCN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC ;IHS/ANMC/CLS 08/18/96
- .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
- LRSORC1 ;SLC/RWF/DALISC/JBM - CRITICAL VALUE REPORT ;JUL 06, 2010 3:14 PM;
- +1 ;;5.2;LAB SERVICE;**153,344,1027**;NOV 01, 1997
- EN ;
- BUILD ;
- +1 SET LRPDT=LREDT-.000001
- +2 FOR
- SET LRPDT=$ORDER(^LRO(69,LRPDT))
- IF ('LRPDT)!(LRPDT>LRSDT)!(LREND=1)
- QUIT
- Begin DoDot:1
- +3 SET LRLLOC=""
- +4 FOR
- SET LRLLOC=$ORDER(^LRO(69,LRPDT,1,"AN",LRLLOC))
- IF LRLLOC=""
- QUIT
- Begin DoDot:2
- +5 SET LRDFN=0
- +6 FOR
- SET LRDFN=$ORDER(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN))
- IF 'LRDFN
- QUIT
- DO LRIDT
- End DoDot:2
- End DoDot:1
- +7 QUIT
- LRIDT ;
- +1 SET LRIDT=0
- SET LRSPEC=0
- +2 FOR
- SET LRIDT=$ORDER(^LRO(69,LRPDT,1,"AN",LRLLOC,LRDFN,LRIDT))
- IF 'LRIDT
- QUIT
- DO LOOK
- +3 QUIT
- LOOK ;
- +1 NEW LR63RLO,LR63RHI,LR63CLO,LR63CHI,LR63TLO,LR63THI,LR63DAT,PC5,LRFLAG
- +2 KILL T
- SET L0=$GET(^LR(LRDFN,"CH",LRIDT,0))
- IF '$LENGTH(L0)
- QUIT
- +3 SET LRSPEC=$PIECE(L0,"^",5)
- +4 IF LRAA
- SET LRAAA=$PIECE($PIECE(L0,U,6)," ")
- IF '$LENGTH(LRAAA)
- QUIT
- IF '$DATA(LRAA(LRAAA))#2
- QUIT
- +5 SET T=0
- SET I=1
- +6 FOR
- SET I=$ORDER(^LR(LRDFN,"CH",LRIDT,I))
- IF LREND!(I<1)
- QUIT
- Begin DoDot:1
- +7 IF $PIECE(^LR(LRDFN,"CH",LRIDT,I),U,2)["*"
- Begin DoDot:2
- +8 SET T=T+1
- SET T(I)=^LR(LRDFN,"CH",LRIDT,I)
- +9 IF $GET(LRFLAG)=""
- Begin DoDot:3
- +10 IF $GET(^LR(LRDFN,"CH",LRIDT,"NPC"))>1
- IF $PIECE(T(I),U,5,12)'=""
- SET LRFLAG=1
- QUIT
- +11 SET LRFLAG=0
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 IF T
- Begin DoDot:1
- +13 SET X=^LR(LRDFN,0)
- +14 SET LRDPF=$PIECE(X,U,2)
- SET DFN=$PIECE(X,U,3)
- +15 IF LRPTS
- IF '$DATA(LRPTS(DFN))
- QUIT
- +16 DO PT^LRX
- +17 SET LRLOC=LRLLOC
- +18 ;S LRLOC=$S($D(^DPT(DFN,.1)):^(.1),1:LRLLOC)
- +19 IF LRLCS
- IF '$DATA(LRLCS(LRLLOC))
- QUIT
- +20 SET LRDAT=$PIECE(^LR(LRDFN,"CH",LRIDT,0),U)
- SET LRSPEC=$PIECE(^(0),U,5)
- +21 ; S LRSUB1=$S(LRSRT="P":PNM_SSN,1:LRLOC)
- +22 ;IHS/ANMC/CLS 08/18/96
- SET LRSUB1=$SELECT(LRSRT="P":PNM_HRCN,1:LRLOC)
- +23 ; S LRSUB2=$S(LRSRT="P":LRDAT,1:PNM_SSN)
- +24 ;IHS/ANMC/CLS 08/18/96
- SET LRSUB2=$SELECT(LRSRT="P":LRDAT,1:PNM_HRCN)
- +25 SET LRSUB3=$SELECT(LRSRT="P":LRLOC,1:LRDAT)
- +26 SET LRAN=$PIECE(L0,U,6)
- +27 KILL %DT
- SET X=$PIECE(L0,U)
- SET %DT="XT"
- DO ^%DT
- DO DD^LRX
- SET LRSPDAT=Y
- +28 ; S ^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_SSN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC
- +29 ;IHS/ANMC/CLS 08/18/96
- SET ^TMP("LR",$JOB,LRSUB1,LRSUB2,LRSUB3,LRAN)=PNM_U_HRCN_U_LRLOC_U_LRDPF_U_LRSPDAT_U_LRSPEC
- +30 SET I=0
- +31 FOR
- SET I=$ORDER(T(I))
- IF LREND!(I<1)
- QUIT
- Begin DoDot:2
- +32 SET LRTX=$ORDER(^LAB(60,"C","CH;"_I_";1",0))
- +33 IF LRTX>0
- Begin DoDot:3
- +34 SET LRTST=$PIECE(^LAB(60,LRTX,0),U)
- SET LRTVAL=$PIECE(T(I),U)
- +35 SET LRCRTFLG=$PIECE(T(I),U,2)
- +36 IF $GET(LRFLAG)
- DO GET63
- +37 SET ^TMP("LR",$JOB,LRSUB1,LRSUB2,LRSUB3,LRAN,"TST",I)=LRTST_U_LRTVAL_U_LRCRTFLG_U_LRSPEC_U_LRTX_U_$GET(LRFLAG)_$SELECT($GET(LRFLAG):LR63DAT,1:"")
- End DoDot:3
- End DoDot:2
- +38 SET C=0
- +39 FOR
- SET C=$ORDER(^LR(LRDFN,"CH",LRIDT,1,C))
- IF 'C
- QUIT
- Begin DoDot:2
- +40 SET ^TMP("LR",$JOB,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)=^LR(LRDFN,"CH",LRIDT,1,C,0)
- End DoDot:2
- End DoDot:1
- +41 QUIT
- +42 ;
- GET63 ; get ranges from file 63 (T(I)) if they are stored there
- +1 SET PC5=$PIECE(T(I),U,5)
- +2 SET LR63RLO=$PIECE(PC5,"!",2)
- +3 SET LR63RHI=$PIECE(PC5,"!",3)
- +4 SET LR63CLO=$PIECE(PC5,"!",4)
- +5 SET LR63CHI=$PIECE(PC5,"!",5)
- +6 SET LR63TLO=$PIECE(PC5,"!",11)
- +7 SET LR63THI=$PIECE(PC5,"!",12)
- +8 SET LR63DAT=U_LR63RLO_U_LR63RHI_U_LR63CLO_U_LR63CHI_U_LR63TLO_U_LR63THI
- +9 QUIT
