| [613] | 1 | LRTSTJM1 ;SLC/RJS- JAM TESTS ONTO (OR OFF) ACCESSIONS (cont.) ;10/10/91 14:00;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | EXPLD ;
|
|---|
| 5 | S LRTSAD1=0 F S LRTSAD1=$O(LRTSAD(LRTSUB,LRTSAD1)) Q:'LRTSAD1 D EXPLD1
|
|---|
| 6 | K LRTSAD1,LRTSAD2,LRTSAD3,LRTSAD4
|
|---|
| 7 | Q
|
|---|
| 8 | EXPLD1 ;
|
|---|
| 9 | Q:'$O(^LAB(60,LRTSAD1,2,0)) S LRTSAD4=LRTSAD1 N LRTSAD1,LRTSAD2,LRTSAD3 S LRTSAD2=LRTSAD4,LRTSAD3=0 K LRTSAD4
|
|---|
| 10 | 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
|
|---|
| 11 | Q
|
|---|
| 12 | COMPTST ;
|
|---|
| 13 | D SCAN K:LRTSUB LRTSAD(2) Q:LRTSUB
|
|---|
| 14 | I '$L(LRTSURG) D COMTST2 S LRTSURG=LRURG I 'LRURG S LRTSUB=0 Q
|
|---|
| 15 | S (LRTSAD,LRTS)=0 F S LRTS=$O(LRTSAD(2,LRTS)) Q:'LRTS I '$D(LRTSAD(1,LRTS)) D COMTST1
|
|---|
| 16 | W:'LRTSAD !,"All the individual tests for this panel",!,"are already included on this accession."
|
|---|
| 17 | K LRTSAD(2),LRTSURG
|
|---|
| 18 | Q
|
|---|
| 19 | COMTST1 ;
|
|---|
| 20 | Q:$O(^LAB(60,LRTS,2,0))
|
|---|
| 21 | 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)
|
|---|
| 22 | D COMTST2:'$L(Y) S LRFLG=1 G:LRURG SETTST^LRTSTJAM
|
|---|
| 23 | Q
|
|---|
| 24 | COMTST2 ;
|
|---|
| 25 | 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
|
|---|
| 26 | W !," ...OK" S %=1 D YN^DICN G COMTST2:%=2 S LRURG=$S((%<1):0,1:+Y)
|
|---|
| 27 | Q
|
|---|
| 28 | SCAN ;
|
|---|
| 29 | N LRTS S LRTS=0 F S LRTS=$O(LRTSAD(2,LRTS)) Q:'LRTS I $D(LRTSAD(1,LRTS)) S LRTSUB=0
|
|---|
| 30 | Q
|
|---|
