- LEXDCCC ;ISL/KER - Default Display - Create ;04/21/2014
- ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^TMP("LEXX") SACC 2.3.2.5.1
- ;
- ; External References
- ; YN^DICN ICR 10009
- ;
- ; Entry: S X=$$EN^LEXDCCC
- ;
- ; Function returns a two piece string
- ;
- ; $P 1 String of classifications coding
- ; system mnemonics, i.e., "ICD/CPT",
- ; and a legitimate value for LEXSHOW.
- ; This will be null if input is "^"
- ;
- ; $P 2 Name of display string selected i.e.,
- ; "ICD/CPT only" This will be null only
- ; when user input is "^^"
- ;
- ; LEXA Answer to prompt (Yes 1 No 0)
- ; LEXC Counter
- ; LEXI Incremental Counter
- ; LEXS Source, i.e., ICD94, NAN90, CPT89
- ; LEXSO Source abbreviation, i.e., ICD, CPT, DSM
- ; LEXR Internal Entry (Record) Number in #757.31
- ;
- ; LEXFIL Flag, indicates that the
- ; classification codes selected are
- ; for building a filter - DIC("S")
- ;
- T S X=$$EN W !!,X Q
- EN(LEXX) ; Entry point S X=$$EN^LEXDCCC
- BUILD ; Build the list to select from
- K ^TMP("LEXX",$J) W @IOF
- W:$D(LEXFIL) !,"Include terms linked to the following classification systems:",!!
- W:'$D(LEXFIL) !,"Display codes belonging to the following classification systems:",!!
- N LEXA,LEXC,LEXI,LEXSO,LEXR,LEXS
- S LEXS=""
- F S LEXS=$O(^LEX(757.03,"B",LEXS)) Q:LEXS="" D
- . Q:'$D(^LEX(757.02,"ASRC",$E(LEXS,1,3)))
- . S LEXSO=$E(LEXS,1,3) I LEXSO="UND" Q
- . S LEXR=$O(^LEX(757.03,"B",LEXS,0))
- . S LEXC=$S($D(^TMP("LEXX",$J,LEXSO)):LEXC+1,1:1)
- . S ^TMP("LEXX",$J,LEXSO,0)=LEXC
- . S ^TMP("LEXX",$J,LEXSO,LEXC)=$P(^LEX(757.03,LEXR,0),U,2,299)
- LIST ; Display the list to select from
- S (LEXX,LEXA,LEXSO)=""
- F S LEXSO=$O(^TMP("LEXX",$J,LEXSO)) Q:LEXSO=""!(LEXA[U) D
- . W !,LEXSO F LEXI=1:1:^TMP("LEXX",$J,LEXSO,0) D
- . . W ?5,$P(^TMP("LEXX",$J,LEXSO,LEXI),U,2),!
- ANS . ; Ask for user selection
- . W:'$D(LEXFIL) "Display these codes during look-up"
- . W:$D(LEXFIL) "Include terms linked to these codes during look-up"
- . S %=2 D YN^DICN S LEXA=%Y I %=2 W ! Q
- . I '%,'$D(LEXFIL) W !,"The codes from the selected coding systems may be displayed with the term.",! G ANS
- . I '%,$D(LEXFIL) W !,"Searches will display terms linked to the selected coding systems",! G ANS
- . I +($G(%))<0 S:%Y["^" LEXA="^" S:%Y["^^" LEXA="^^" W ! Q
- . S LEXX=LEXX_"/"_LEXSO W ! Q
- I $E(LEXX,1)="/" S LEXX=$E(LEXX,2,$L(LEXX))
- S:$D(LEXFIL) LEXX=LEXX_"^" I '$D(LEXFIL) D
- . N LEXNAM S LEXNAM=""
- . S:$P(LEXX,U,1)'="" LEXNAM=$$NAME^LEXDM3
- . S LEXX=LEXX_"^"_$S($L(LEXX):LEXNAM,1:"No display selected")
- S:LEXA["^^" LEXX="^^"
- K ^TMP("LEXX",$J),%,LEXA,LEXC,LEXI,LEXSO,LEXS,LEXR
- Q LEXX
- LEXDCCC ;ISL/KER - Default Display - Create ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^TMP("LEXX") SACC 2.3.2.5.1
- +5 ;
- +6 ; External References
- +7 ; YN^DICN ICR 10009
- +8 ;
- +9 ; Entry: S X=$$EN^LEXDCCC
- +10 ;
- +11 ; Function returns a two piece string
- +12 ;
- +13 ; $P 1 String of classifications coding
- +14 ; system mnemonics, i.e., "ICD/CPT",
- +15 ; and a legitimate value for LEXSHOW.
- +16 ; This will be null if input is "^"
- +17 ;
- +18 ; $P 2 Name of display string selected i.e.,
- +19 ; "ICD/CPT only" This will be null only
- +20 ; when user input is "^^"
- +21 ;
- +22 ; LEXA Answer to prompt (Yes 1 No 0)
- +23 ; LEXC Counter
- +24 ; LEXI Incremental Counter
- +25 ; LEXS Source, i.e., ICD94, NAN90, CPT89
- +26 ; LEXSO Source abbreviation, i.e., ICD, CPT, DSM
- +27 ; LEXR Internal Entry (Record) Number in #757.31
- +28 ;
- +29 ; LEXFIL Flag, indicates that the
- +30 ; classification codes selected are
- +31 ; for building a filter - DIC("S")
- +32 ;
- T SET X=$$EN
- WRITE !!,X
- QUIT
- EN(LEXX) ; Entry point S X=$$EN^LEXDCCC
- BUILD ; Build the list to select from
- +1 KILL ^TMP("LEXX",$JOB)
- WRITE @IOF
- +2 IF $DATA(LEXFIL)
- WRITE !,"Include terms linked to the following classification systems:",!!
- +3 IF '$DATA(LEXFIL)
- WRITE !,"Display codes belonging to the following classification systems:",!!
- +4 NEW LEXA,LEXC,LEXI,LEXSO,LEXR,LEXS
- +5 SET LEXS=""
- +6 FOR
- SET LEXS=$ORDER(^LEX(757.03,"B",LEXS))
- IF LEXS=""
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^LEX(757.02,"ASRC",$EXTRACT(LEXS,1,3)))
- QUIT
- +8 SET LEXSO=$EXTRACT(LEXS,1,3)
- IF LEXSO="UND"
- QUIT
- +9 SET LEXR=$ORDER(^LEX(757.03,"B",LEXS,0))
- +10 SET LEXC=$SELECT($DATA(^TMP("LEXX",$JOB,LEXSO)):LEXC+1,1:1)
- +11 SET ^TMP("LEXX",$JOB,LEXSO,0)=LEXC
- +12 SET ^TMP("LEXX",$JOB,LEXSO,LEXC)=$PIECE(^LEX(757.03,LEXR,0),U,2,299)
- End DoDot:1
- LIST ; Display the list to select from
- +1 SET (LEXX,LEXA,LEXSO)=""
- +2 FOR
- SET LEXSO=$ORDER(^TMP("LEXX",$JOB,LEXSO))
- IF LEXSO=""!(LEXA[U)
- QUIT
- Begin DoDot:1
- +3 WRITE !,LEXSO
- FOR LEXI=1:1:^TMP("LEXX",$JOB,LEXSO,0)
- Begin DoDot:2
- +4 WRITE ?5,$PIECE(^TMP("LEXX",$JOB,LEXSO,LEXI),U,2),!
- End DoDot:2
- ANS ; Ask for user selection
- +1 IF '$DATA(LEXFIL)
- WRITE "Display these codes during look-up"
- +2 IF $DATA(LEXFIL)
- WRITE "Include terms linked to these codes during look-up"
- +3 SET %=2
- DO YN^DICN
- SET LEXA=%Y
- IF %=2
- WRITE !
- QUIT
- +4 IF '%
- IF '$DATA(LEXFIL)
- WRITE !,"The codes from the selected coding systems may be displayed with the term.",!
- GOTO ANS
- +5 IF '%
- IF $DATA(LEXFIL)
- WRITE !,"Searches will display terms linked to the selected coding systems",!
- GOTO ANS
- +6 IF +($GET(%))<0
- IF %Y["^"
- SET LEXA="^"
- IF %Y["^^"
- SET LEXA="^^"
- WRITE !
- QUIT
- +7 SET LEXX=LEXX_"/"_LEXSO
- WRITE !
- QUIT
- End DoDot:1
- +8 IF $EXTRACT(LEXX,1)="/"
- SET LEXX=$EXTRACT(LEXX,2,$LENGTH(LEXX))
- +9 IF $DATA(LEXFIL)
- SET LEXX=LEXX_"^"
- IF '$DATA(LEXFIL)
- Begin DoDot:1
- +10 NEW LEXNAM
- SET LEXNAM=""
- +11 IF $PIECE(LEXX,U,1)'=""
- SET LEXNAM=$$NAME^LEXDM3
- +12 SET LEXX=LEXX_"^"_$SELECT($LENGTH(LEXX):LEXNAM,1:"No display selected")
- End DoDot:1
- +13 IF LEXA["^^"
- SET LEXX="^^"
- +14 KILL ^TMP("LEXX",$JOB),%,LEXA,LEXC,LEXI,LEXSO,LEXS,LEXR
- +15 QUIT LEXX
