47 lines
3.4 KiB
Mathematica
47 lines
3.4 KiB
Mathematica
LRTSTJAM ;SLC/CJS/JAH - JAM TESTS ONTO (OR OFF) ACCESSIONS ;8/10/04
|
|
;;5.2;LAB SERVICE;**121,153,291**;Sep 27, 1994
|
|
EN ;
|
|
ADD I $G(LRAA),$G(LRAD),$G(LRAN) L -^LRO(68,LRAA,1,LRAD,1,LRAN)
|
|
K LRPARAM D ^LRPARAM G:'$D(LRPARAM) END S LRACC=1 D LRACC^LRTSTOUT K LRACC,LRTSAD,LRNATURE G:LRAN<1 END ;ADD A TEST
|
|
I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),U,2) W !?5,"This is not a valid Accession number ",!,$C(7) G ADD
|
|
L +^LRO(68,LRAA,1,LRAD,1,LRAN):1 I '$T W !?5,"Someone else is editing this entry ",!,$C(7) G ADD
|
|
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRDFN=$P(X,U),LRAODT=$P(X,U,3),LRODT=$P(X,U,4),LRSN=$P(X,U,5),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM,?30,SSN
|
|
D:'$D(LRNATURE) NEW^LROR6() I $G(LRNATURE)=-1 W !!,"...process aborted",$C(7) K LRNATURE G ADD
|
|
W !,"TESTS ALREADY ON THE ACCESSION: " S I=0 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 W !,?5,$P(^LAB(60,I,0),U,1) S LRTSAD(1,I)=""
|
|
LRTSP W ! K DIC,DA S DIC("A")="Select Original Ordered Test ",DA=LRSN,DA(1)=LRODT
|
|
I $P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),U,2) S DIC("S")="I $L($P($G(^(.3)),U))"
|
|
S DIC="^LRO(69,"_LRODT_",1,"_LRSN_",2,",DIC(0)="AQEZNM"
|
|
W ! D ^DIC K DIC,DA G:Y<1 ADD S LRTSP=$P(Y,U,2) W !
|
|
ADDTST S DIC("A")="Add LABORATORY TEST: ",DIC=60,DIC(0)="AEMOQ",DIC("S")="I $P(^(0),U,4)'="""""_$S('$D(^XUSEC("LRSUPER",DUZ)):",""N""'[$P(^(0),U,3)",1:"") D ^DIC K DIC("A"),DIC("S") G ADD:Y<1 W !," ...OK" S %=1 D YN^DICN
|
|
G ADDTST:%=2,ADD:%'=1 S (LRTS,I)=+Y I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)) W !,"The accession already has this test." G ADDTST
|
|
S LRTSUB=1 D EXPLD^LRTSTJM1 I $D(LRTSAD(1,LRTS)) W !,"The accession already has this test." G ADDTST
|
|
I $D(^LAB(60,I,8,+DUZ(2),0)) S J=$P(^LAB(60,I,8,+DUZ(2),0),U,2) I J,J'=LRAA W !,"That test normally belongs to accession area ",$P(^LRO(68,J,0),U),",",!,"are you sure" S %=2 D YN^DICN G ADD:%'=1
|
|
I $O(^LAB(60,LRTS,2,0)) S LRTSURG=$P(^LAB(60,LRTS,0),U,18) K LRTSAD(2) S LRTSAD(2,LRTS)="" S LRTSUB=2 D EXPLD^LRTSTJM1,COMPTST^LRTSTJM1 I 'LRTSUB G ADDTST
|
|
S LRFLG=1 S (LRURG,Y)=$P(^LAB(60,I,0),U,18) G SETTST:$L(Y)
|
|
ADDURG S DIC=62.05,DIC("B")="ROUTINE" D ^DIC K DIC("B") W:Y<1 !,"URGENCY must be defined. Test not added." G ADDTST:Y<1 W !," ...OK" S %=1 D YN^DICN
|
|
G ADDURG:%=2,ADD:%<1 S LRURG=+Y,LRFLG=""
|
|
SETTST ;
|
|
D:+LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT))
|
|
.S LRBERF=$$RFLX^LRBEBA4() ; CIDC
|
|
G EN^LRTSTSET Q
|
|
Q
|
|
IDENT ;D LRACC^LRTSTOUT Q:LREND
|
|
FXID S LRACC=1 D LRACC^LRTSTOUT K LRACC Q:LRAN<1 ;R !,"What Accession number: ",X:DTIME Q:X=""!(X["^")
|
|
S LRWDT1=DA(1) D:$D(^LRO(68,LRAA,.3))#2 ^LRWLST2 G FXID
|
|
;
|
|
% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
|
|
Q
|
|
END I $G(LRAA),$G(LRAD),$G(LRAN) L -^LRO(68,LRAA,1,LRAD,1,LRAN)
|
|
K %,A,AGE,DD,DFN,DIC,DIE,DO,DOB,DR,I,K,LRAA,LRAD,LRACD,LRAN,LRCCOM,LRDFN,LRDPF,LREND,LRIDT,LRODT,LRSN,LRSS,LRTNM,LRTS,LRWRD,PNM,SEX,SSN,X,Y,Z,LRUSNM
|
|
K %DT,%H,%X,%Y,DA,J,LRBED,LRCS,LRCSS,LRDTM,LRDTO,LRGVP,LRIDENT,LRIOZERO,LRLLOC,LRLWC,LRNOP,LRONE,LRORD,LRORDTIM,LROWLE,LRPR,LRTP,LRTSN,LRUR,LRUSNM,LRWDT1,LRXD,POP,T
|
|
K LRTSAD,LRTSUB,LRDATE,D,D0,D1,DN,LRAODT,LRFLG,LRRB,LRSAMP,LRTREA,LRTSP
|
|
K LRURG,VA,LRX,LRBERF,LRBETN
|
|
Q
|
|
CHK ;from LRTSTJAN
|
|
D CHK1 I LREND W !,$C(7),"CAN'T DO IT. The data has been approved for that log number."
|
|
Q
|
|
CHK1 I $D(^LRO(68,LRWL1,1,LRWDT1,1,LRAN,3)),$P(^(3),U,4) S LREND=1 Q
|
|
I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),U,2) S LREND=1 Q
|
|
S LRTST=0 F S LRTST=$O(^LRO(68,LRWL1,1,LRWDT1,1,LRAN,4,LRTST)) Q:LRTST<1 I $D(^(LRTST,0)),$P(^(0),U,5) S LREND=1 Q
|
|
Q
|