88 lines
3.4 KiB
Mathematica
88 lines
3.4 KiB
Mathematica
LRRP ;DALOI/RWF/BA - PROCESS DATA FOR INTERIM REPORTS ; 11/10/88 08:48
|
|
;;5.2;LAB SERVICE;**195,221,283,286**;Sep 27, 1994
|
|
;
|
|
SET ;from LRRSP, LRRS, LRRD - call with LRORDER=ORDERS, LRODT=DATE, LRDFN
|
|
K ^TMP("LR",$J,"TP"),LRORD
|
|
S:'$D(LRTSCRN) LRTSCRN=0
|
|
S LRLAB=$S($D(LRLABKY):1,1:0),LRHF=1,LRFOOT=0,LRCW=8 Q:'$D(LRODT)
|
|
F LROP=1:1 S LRORD(1)=$P(LRORDER,U,LROP) D TEST Q:LRSTOP!LREND!(LRORD(1)="")
|
|
I 'LREND,'LRSTOP,LRFOOT D FOOT^LRRP1
|
|
K ^TMP("LR",$J,"TP"),LRORD
|
|
Q
|
|
;
|
|
;
|
|
TEST ;
|
|
I LRORD(1)="" K ^TMP("LR",$J,"TP") Q
|
|
S LRFOUND=1,LRORD=$S($D(^LRO(69,LRODT,1,LRORD(1),0))#2:^(0),1:"") Q:LRORD=""!(+LRORD'=LRDFN)
|
|
K S,LRAAO S LRTEST=0
|
|
F S LRTEST=+$O(^LRO(69,LRODT,1,LRORD(1),2,LRTEST)) Q:LRTEST<1 S X=^(LRTEST,0) I LRTSCRN=0!(LRTSCRN=+X) D DATA K S
|
|
K S Q:'$D(LRAAO) Q:LRAAO<.1
|
|
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
|
|
S LROC=$S($D(^LR(LRDFN,.1)):^(.1),LRDPF=2&$D(^DPT(DFN,.1)):^(.1),1:"FILE ROOM")
|
|
D ^LRRP1
|
|
Q
|
|
;
|
|
;
|
|
DATA S LRTSTS=+X,LRAD=$P(X,U,3),LRAA=+$P(X,U,4),LRAN=$P(X,U,5)
|
|
S LRAAO=$S($D(^LRO(68,LRAA,0)):$P(^(0),U,8),1:0)
|
|
I LRAAO<.1 Q:'LRAA D Q
|
|
. W !?2,$C(7),$P(^LRO(68,LRAA,0),"^")_" accession area is missing a print order!",!?2,$P(^LAB(60,LRTSTS,0),"^")_" results will not be displayed until this is corrected.",!?2,"Please contact IRM or the Lab ADPAC."
|
|
S LRSS=$P(^LRO(68,LRAA,0),U,2)
|
|
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q:'$D(^(3))
|
|
S ^TMP("LR",$J,"TP",LRAAO)=LRAA_U_LRSS
|
|
S LRCDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U)
|
|
S LRIDT=+$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
|
|
I 'LRIDT S LRIDT=9999999-LRCDT
|
|
S ^TMP("LR",$J,"TP",LRAAO,LRCDT,-1)=$S($D(^TMP("LR",$J,"TP",LRAAO,-1)):^(-1),1:"")_LRTSTS_U
|
|
S ^TMP("LR",$J,"TP",LRAAO,LRCDT,-2)=LRIDT
|
|
Q:LRSS="MI"
|
|
S (S,J)=0
|
|
F S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J)) Q:J<1 S:^(J,0)>0 S=S+1,S(S)=+^(0)
|
|
S LR0=$S($D(^LR(LRDFN,LRSS,LRIDT,0)):^(0),1:""),LRSPEC=+$P(LR0,U,5),(LRTC,LRLLT)=0
|
|
F S LRLLT=+$O(S(LRLLT)) Q:LRLLT<1 S LRTSTS=+S(LRLLT) D XPND
|
|
D CMNT
|
|
Q
|
|
;
|
|
;
|
|
XPND Q:'$D(^LAB(60,LRTSTS,.1)) S LRDN=$P($P(^(0),U,5),";",2)
|
|
I '$L(LRDN) S LRJJ=0 F S LRJJ=+$O(^LAB(60,LRTSTS,2,LRJJ)) Q:LRJJ<1 S S=S+1,S(S)=+^(LRJJ,0)
|
|
D:$L(LRDN) SETUP
|
|
Q
|
|
;
|
|
;
|
|
SETUP Q:'LRTSTS Q:'$D(^LAB(60,LRTSTS,.1)) S X=^(.1)
|
|
I 'LRLAB,"BO"'[$P(^LAB(60,LRTSTS,0),U,3) Q
|
|
Q:'$D(^LR(LRDFN,LRSS,LRIDT,LRDN)) Q:'$L($P(^(LRDN),U))
|
|
S LRPO=$P(X,U,6),LRPO=$S(LRPO:LRPO,1:LRDN/1000000)
|
|
F Q:'$D(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO)) Q:LRTSTS=+^(LRPO) S LRPO=LRPO+1
|
|
Q:$D(^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO))
|
|
S ^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO)=LRTSTS_U_$P(^LAB(60,LRTSTS,0),U)_U_$P(X,U)_U_$P(X,U,2)_U_$P(X,U,3)_U_$P(^(0),U,5)_U_$P(^LR(LRDFN,LRSS,LRIDT,LRDN),U)_U_$P(^(LRDN),U,2)_U_$P(^(LRDN),U,9)_U_LRDN,LRTC=LRTC+1
|
|
;
|
|
I $D(^LAB(60,LRTSTS,1,LRSPEC,1,0)) D
|
|
. S LRINTP=0
|
|
. F S LRINTP=+$O(^LAB(60,LRTSTS,1,LRSPEC,1,LRINTP)) Q:LRINTP<1 S ^TMP("LR",$J,"TP",LRAAO,LRCDT,LRPO,LRINTP)=^(LRINTP,0) S LRTC=LRTC+1
|
|
Q
|
|
;
|
|
;
|
|
CMNT ;
|
|
S ^TMP("LR",$J,"TP",LRAAO)=LRAA_U_LRSS,^(LRAAO,LRCDT)=LR0,^(LRCDT,-1)=""
|
|
S ^TMP("LR",$J,"TP",LRAAO,LRCDT,-2)=LRIDT
|
|
;
|
|
S LRCMNT=0 F I=0:0 S LRCMNT=+$O(^LR(LRDFN,LRSS,LRIDT,1,LRCMNT)) Q:LRCMNT<1 S ^TMP("LR",$J,"TP",LRAAO,LRCDT,"C",LRCMNT)=^(LRCMNT,0) S LRTC=LRTC+1
|
|
S $P(^TMP("LR",$J,"TP",LRAAO,LRCDT),U,12)=LRTC
|
|
Q
|
|
;
|
|
;
|
|
CH ;from LRRP2
|
|
S LRDN=1
|
|
F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 S LRTSTS=$O(^LAB(60,"C","CH;"_LRDN_";1",0)) D SETUP
|
|
D CMNT,^LRRP1
|
|
Q
|
|
;
|
|
;
|
|
GO ;from LRRP3
|
|
S LRLAB=$S($D(LRLABKY):1,1:0),LRDN=1
|
|
F S LRDN=$O(^TMP("LR",$J,"TMP",LRDN)) Q:LRDN<1 S LRTSTS=+^(LRDN) D SETUP
|
|
D CMNT,^LRRP1
|
|
Q
|