31 lines
1.3 KiB
Mathematica
31 lines
1.3 KiB
Mathematica
LRTSTJM1 ;SLC/RJS- JAM TESTS ONTO (OR OFF) ACCESSIONS (cont.) ;10/10/91 14:00;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
;
|
|
EXPLD ;
|
|
S LRTSAD1=0 F S LRTSAD1=$O(LRTSAD(LRTSUB,LRTSAD1)) Q:'LRTSAD1 D EXPLD1
|
|
K LRTSAD1,LRTSAD2,LRTSAD3,LRTSAD4
|
|
Q
|
|
EXPLD1 ;
|
|
Q:'$O(^LAB(60,LRTSAD1,2,0)) S LRTSAD4=LRTSAD1 N LRTSAD1,LRTSAD2,LRTSAD3 S LRTSAD2=LRTSAD4,LRTSAD3=0 K LRTSAD4
|
|
F S LRTSAD3=$O(^LAB(60,LRTSAD2,2,LRTSAD3)) Q:'LRTSAD3 I $D(^(LRTSAD3,0)),'$D(LRTSAD(LRTSUB,+^(0))) S LRTSAD1=+^(0),LRTSAD(LRTSUB,LRTSAD1)="" D EXPLD1
|
|
Q
|
|
COMPTST ;
|
|
D SCAN K:LRTSUB LRTSAD(2) Q:LRTSUB
|
|
I '$L(LRTSURG) D COMTST2 S LRTSURG=LRURG I 'LRURG S LRTSUB=0 Q
|
|
S (LRTSAD,LRTS)=0 F S LRTS=$O(LRTSAD(2,LRTS)) Q:'LRTS I '$D(LRTSAD(1,LRTS)) D COMTST1
|
|
W:'LRTSAD !,"All the individual tests for this panel",!,"are already included on this accession."
|
|
K LRTSAD(2),LRTSURG
|
|
Q
|
|
COMTST1 ;
|
|
Q:$O(^LAB(60,LRTS,2,0))
|
|
S LRTSAD=1,(Y,LRURG)=$S($L(LRTSURG):LRTSURG,1:$P(^LAB(60,LRTS,0),U,18)) W:'$L(Y) !,$P(^LAB(60,LRTS,0),U,1)
|
|
D COMTST2:'$L(Y) S LRFLG=1 G:LRURG SETTST^LRTSTJAM
|
|
Q
|
|
COMTST2 ;
|
|
S DIC=62.05,DIC("B")="ROUTINE",DIC(0)="AEMOQ" D ^DIC K DIC("B") I Y<1 W !,"URGENCY must be defined. Test not added." S LRURG=0 Q
|
|
W !," ...OK" S %=1 D YN^DICN G COMTST2:%=2 S LRURG=$S((%<1):0,1:+Y)
|
|
Q
|
|
SCAN ;
|
|
N LRTS S LRTS=0 F S LRTS=$O(LRTSAD(2,LRTS)) Q:'LRTS I $D(LRTSAD(1,LRTS)) S LRTSUB=0
|
|
Q
|