111 lines
5.1 KiB
Mathematica
111 lines
5.1 KiB
Mathematica
LRWLST ;FHS/DALOI - ACCESSION SETUP. LROE1,LRSTIK & LRFAST CALL HERE ; Aug 9, 2004
|
|
;;5.2;LAB SERVICE;**46,65,100,121,153,202,290**;Sep 27, 1994
|
|
N LRPWL,LRPWDT,LRPWLE
|
|
D DT^LRX
|
|
Q:$G(LRKIL)
|
|
D:$D(XRTL) T0^%ZOSV ; START RESPONSE TIME LOGGING
|
|
S LRCDT=+^LRO(69,LRODT,1,LRSN,1),LREAL=$P(^(1),U,2),X=^(0),LRLLOC=$P(X,U,7),LROLLOC=$P(X,U,9),LRORIFN=$P(X,"^",11)
|
|
D LRAA,^LRWLST1
|
|
S LRCDT=(+LRCDT)_"^"_LREAL
|
|
I '$L($P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7)) S CONTROL=$S($L(LRORIFN):"SC",1:"SN") D NEW^LR7OB1(LRODT,LRSN,CONTROL,,,6)
|
|
K LRTSTS,^TMP("LR",$J,"TMP"),LRNM,DIC,I,LRORIFN,LRBACK
|
|
I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
|
|
Q
|
|
;
|
|
LRAA ;
|
|
K LRTSTS,^TMP("LR",$J,"TMP")
|
|
S LRTSTS=0,LRIX=0,S5=0,LRTN=0
|
|
F S LRTN=$O(^LRO(69,LRODT,1,LRSN,2,LRTN)) Q:LRTN<1 D
|
|
. N LRX
|
|
. S LRX=^(LRTN,0) I '$P(LRX,U,3),'$P(LRX,U,6),'$P(LRX,U,8),'$P(LRX,U,11) S LRORIFN=$P(LRX,"^",7),LRBACK=$P(LRX,"^",14) D SET
|
|
WL1 ;
|
|
; LRDAA is used by POC interface to specify the POC accession area.
|
|
S LRIX=0
|
|
F S LRIX=$O(^TMP("LR",$J,"TMP",LRIX)) Q:LRIX<1 D
|
|
. S X=^(LRIX),LRTSTS=+X,LRURG=$P(X,"^",2),LRORIFN=$P(X,"^",4),LRBACK=$P(X,"^",5)
|
|
. S LRST=^LAB(60,LRTSTS,0)
|
|
. S LRAA=$S($G(LRDAA)>0:LRDAA,$D(^LAB(60,LRTSTS,8,$S($G(LRDUZ(2))>0:LRDUZ(2),1:DUZ(2)),0)):$P(^(0),U,2),1:"")
|
|
. S LRNM=$P(LRST,U),LRUNQ=+$P(LRST,U,7)
|
|
. D WL2
|
|
Q
|
|
;
|
|
WL2 ;
|
|
D FWL:$G(LRAA)="" Q:LRAA=""
|
|
S LRWL0=^LRO(68,LRAA,0),LRSS=$P(LRWL0,U,2),LRIDIV=$S($L($P(LRWL0,U,19)):$P(LRWL0,U,19),1:"CP")
|
|
I '$D(LRPHSET),$D(LRNCWL) W !,LRNM," TO ",$P(^LRO(68,LRAA,0),U)," accessions","? Y//" D YN Q:X="^" IF X["N" S LRAA="" G WL2
|
|
;added following line to support unique ID/DALISC/JRR
|
|
I $P($G(^LRO(68,LRAA,.4)),U)="" D S LRAA="" Q
|
|
. W:'$D(LRPHSET) !!?5,"You must enter a 'Numeric Identifier' in field .4 of the Accession file!!",!?10,"Accession Area ",$P($G(^LRO(68,+$G(LRAA),0)),U),!
|
|
. D UNDO
|
|
S LRPWL=$P($G(^LRO(68,LRAA,0)),U,4)
|
|
I LRPWL,$P($G(^LRO(68,LRPWL,.4)),U)="" D S LRAA="" Q
|
|
. I $G(LRQUIET) D UNDO Q
|
|
. W:'$D(LRPHSET) !!?5,"You must enter a 'Numeric Identifier' in field .4 of the Accession file!!"
|
|
. W !?10,"COMMON Accession Area ",$P($G(^LRO(68,+$G(LRPWL),0)),U),!
|
|
. D UNDO
|
|
;
|
|
S LRWLC=$P(LRWL0,U,4)
|
|
S:'LRWLC LRWLC=LRAA
|
|
S LRTSTS(LRWLC,LRUNQ,LRAA)=LRSS_U_$P(LRWL0,U,12),LRTSTS(LRWLC,LRUNQ,LRAA,LRIX)=^TMP("LR",$J,"TMP",LRIX)
|
|
Q
|
|
SET ;
|
|
I $G(LRORDRR)="R" S LRTEST(LRTN)=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0))
|
|
S S5=S5+1,I5=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0))
|
|
I I5 S ^TMP("LR",$J,"TMP",S5)=$P(I5,U)_U_$P(I5,U,2)_U_LRTN_U_LRORIFN_U_LRBACK_U_$S($G(LRTSP):LRTSP,1:$P(I5,U)),I5=LRTN
|
|
Q
|
|
FWL ;
|
|
I $O(^LAB(60,LRTSTS,2,0))>0 D EXP S $P(^LRO(69,LRODT,1,LRSN,2,$P(^TMP("LR",$J,"TMP",LRIX),U,3),0),U,8)=1 Q
|
|
I '$D(LRNCWL),$D(LRPHSET),LRPHSET W !,"NO ACCESSION AREA FOR ORDER NUMBER ",^LRO(69,LRODT,1,LRSN,.1)," TEST ",$P(^LAB(60,LRTSTS,0),U),! D UNDO Q
|
|
I '$D(LRNCWL) W !,LRNM," does not have an appropriate accession area.",!,"ORDER # ",LRORD," IS NOT ACCESSIONED",! S LRAA="" D UNDO Q
|
|
W !,"For test: ",LRNM
|
|
K DIC
|
|
S DIC("S")="I '$L($P(^(0),U,17))",DIC="^LRO(68,",DIC(0)="AEFOQZ"
|
|
D ^DIC
|
|
K DIC
|
|
I $D(DUOUT) S LRAA="" Q
|
|
G:Y<1 FWL
|
|
S LRAA=+Y
|
|
Q
|
|
EXP ;
|
|
S I=0
|
|
F S I=$O(^LAB(60,LRTSTS,2,I)) Q:I<1 S J=+^(I,0) I $D(^LAB(60,J,8,DUZ(2),0)) S S5=S5+1,I5=I5+1,^TMP("LR",$J,"TMP",S5)=J_"^"_LRURG_"^"_I5_"^"_LRORIFN_"^"_LRBACK_"^"_$S($G(LRTSP):LRTSP,1:LRTSTS)
|
|
Q
|
|
PRESET ;
|
|
I '($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2) K ^LRO(68,LRAA,1,LRAD,1,LRAN) Q
|
|
S LROLRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
|
|
I $L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5)) S LRDPF=$P(^LR(LROLRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM," ",SSN," has that log #." S LREND=1 Q ;W !," OK to change it? N//" D YN I X=""!(X'["Y") S LREND=1 Q
|
|
S LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3)
|
|
Q:'$D(^LR(LROLRDFN,LRSS,LRIDT,0))
|
|
PR2 ;
|
|
S LRNIDT=9999999-LRCDT
|
|
F Q:'$D(^LR(LRDFN,LRSS,LRNIDT,0)) D
|
|
. S LRCDT=$$FMADD^XLFDT(LRCDT,,,,1)
|
|
. S LRNIDT=9999999-LRCDT
|
|
I $P(^LR(LROLRDFN,LRSS,LRIDT,0),U,3) S LREND=1 W !,$C(7),"CAN'T DO IT. The data has been verified for that log number." Q
|
|
S ^LR(LRDFN,LRSS,LRNIDT,0)=LRCDT_U_LREAL_U_$P(^LR(LROLRDFN,LRSS,LRIDT,0),U,3,4)_U_U_$P(^(0),U,6,99)
|
|
S J=0 F S J=$O(^LR(LROLRDFN,LRSS,LRIDT,J)) Q:J<1 S ^LR(LRDFN,LRSS,LRNIDT,J)=^LR(LROLRDFN,LRSS,LRIDT,J)
|
|
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LROSN=$P(X,U,5),LROID=$P(X,U,6),LROCN=$S($D(^(.1)):$P(^(.1),U),1:"")
|
|
K:$L(LROID) ^LRO(68,LRAA,1,LRAD,1,"C",LROID,LRAN)
|
|
K:$L(LROCN) ^LRO(68,LRAA,1,LRAD,1,"D",LROCN,LRAN)
|
|
K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LR(LROLRDFN,LRSS,LRIDT)
|
|
Q
|
|
YN ;
|
|
R X:DTIME
|
|
S:'$T DTOUT=1
|
|
Q:X=""!(X["N")!(X["Y")
|
|
W !,"Answer 'Y' or 'N': " G YN
|
|
UNDO ;Clean up ^LRO(69
|
|
N X,TST
|
|
S LRIFN=+$O(^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS,0)) Q:LRIFN<1
|
|
S $P(^LRO(69,LRODT,1,LRSN,2,LRIFN,0),"^",3,6)="^^^"
|
|
S $P(^LRO(69,LRODT,1,LRSN,1),U,4)="U" ;,$P(^(1),U,6)=LRNM_" NOT ACCESSIONED - TEST DEFINITION INCOMPLETE"
|
|
Q
|
|
S X=$G(^LRO(69,LRODT,1,LRSN,2,LRIFN,0)) Q:'X S TST(+X)=""
|
|
S X=$S($D(^LRO(69,LRODT,1,LRSN,2,LRIFN,1.1,0)):$P(^(0),"^",3),1:0)+1,^(0)="^^"_X_"^"_X_"^"_DT,^(X,0)="Not accessioned - Test definition incomplete"
|
|
D NEW^LR7OB1(LRODT,LRSN,"OC",,.TST)
|
|
S $P(^LRO(69,LRODT,1,LRSN,2,LRIFN,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^L^"_DUZ
|
|
Q
|
|
OR ;from LRPHITEM
|
|
I $G(LRORDRR)="R" S LRTEST(LRTN)=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0)) Q
|
|
Q
|