- LRTSTJM1 ; IHS/DIR/FJE - JAM TESTS ONTO (OR OFF) ACCESSIONS (cont.) 10/10/91 14:00 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;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
- LRTSTJM1 ; IHS/DIR/FJE - JAM TESTS ONTO (OR OFF) ACCESSIONS (cont.) 10/10/91 14:00 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 ;
- EXPLD ;
- +1 SET LRTSAD1=0
- FOR
- SET LRTSAD1=$ORDER(LRTSAD(LRTSUB,LRTSAD1))
- IF 'LRTSAD1
- QUIT
- DO EXPLD1
- +2 KILL LRTSAD1,LRTSAD2,LRTSAD3,LRTSAD4
- +3 QUIT
- EXPLD1 ;
- +1 IF '$ORDER(^LAB(60,LRTSAD1,2,0))
- QUIT
- SET LRTSAD4=LRTSAD1
- NEW LRTSAD1,LRTSAD2,LRTSAD3
- SET LRTSAD2=LRTSAD4
- SET LRTSAD3=0
- KILL LRTSAD4
- +2 FOR
- SET LRTSAD3=$ORDER(^LAB(60,LRTSAD2,2,LRTSAD3))
- IF 'LRTSAD3
- QUIT
- IF $DATA(^(LRTSAD3,0))
- IF '$DATA(LRTSAD(LRTSUB,+^(0)))
- SET LRTSAD1=+^(0)
- SET LRTSAD(LRTSUB,LRTSAD1)=""
- DO EXPLD1
- +3 QUIT
- COMPTST ;
- +1 DO SCAN
- IF LRTSUB
- KILL LRTSAD(2)
- IF LRTSUB
- QUIT
- +2 IF '$LENGTH(LRTSURG)
- DO COMTST2
- SET LRTSURG=LRURG
- IF 'LRURG
- SET LRTSUB=0
- QUIT
- +3 SET (LRTSAD,LRTS)=0
- FOR
- SET LRTS=$ORDER(LRTSAD(2,LRTS))
- IF 'LRTS
- QUIT
- IF '$DATA(LRTSAD(1,LRTS))
- DO COMTST1
- +4 IF 'LRTSAD
- WRITE !,"All the individual tests for this panel",!,"are already included on this accession."
- +5 KILL LRTSAD(2),LRTSURG
- +6 QUIT
- COMTST1 ;
- +1 IF $ORDER(^LAB(60,LRTS,2,0))
- QUIT
- +2 SET LRTSAD=1
- SET (Y,LRURG)=$SELECT($LENGTH(LRTSURG):LRTSURG,1:$PIECE(^LAB(60,LRTS,0),U,18))
- IF '$LENGTH(Y)
- WRITE !,$PIECE(^LAB(60,LRTS,0),U,1)
- +3 IF '$LENGTH(Y)
- DO COMTST2
- SET LRFLG=1
- IF LRURG
- GOTO SETTST^LRTSTJAM
- +4 QUIT
- COMTST2 ;
- +1 SET DIC=62.05
- SET DIC("B")="ROUTINE"
- SET DIC(0)="AEMOQ"
- DO ^DIC
- KILL DIC("B")
- IF Y<1
- WRITE !,"URGENCY must be defined. Test not added."
- SET LRURG=0
- QUIT
- +2 WRITE !," ...OK"
- SET %=1
- DO YN^DICN
- IF %=2
- GOTO COMTST2
- SET LRURG=$SELECT((%<1):0,1:+Y)
- +3 QUIT
- SCAN ;
- +1 NEW LRTS
- SET LRTS=0
- FOR
- SET LRTS=$ORDER(LRTSAD(2,LRTS))
- IF 'LRTS
- QUIT
- IF $DATA(LRTSAD(1,LRTS))
- SET LRTSUB=0
- +2 QUIT
