- ICDEXLK4 ;SLC/KER - ICD Extractor - Lookup, Search Text ;12/19/2014
- ;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21
- ;
- ; Global Variables
- ; ^TMP(SUB,$J SACC 2.3.2.5.1
- ;
- ; External References
- ; $$LOW^XLFSTR ICR 10104
- ; $$UP^XLFSTR ICR 10104
- ;
- ; Local Variables Newed or Killed by calling application
- ; DIC(0) Fileman Lookup Parameters
- ;
- ; Local Variables Newed or Killed Elsewhere
- ; ICDBYCD Sort by Code
- ; CDT Code Set Date
- ; OUT Format of display
- ; SYS Coding System
- ; VER Versioned Lookup
- ; SUB ^TMP Subscript
- ; SYS Coding System
- ;
- TXT ; Lookup by Text (Requires TXT and ROOT)
- Q:$D(ICDBYCD) Q:'$L($G(TXT)) Q:'$L($G(ROOT)) Q:$L(TXT)'>1 Q:$G(DIC(0))["B"
- S CDT=$$CDT^ICDEXLK3($G(CDT)) N PARS,ORG,CNT,PRV,EROOT,KEY,LOOK,EXACT,ABBR,PRIME
- S:'$L($G(SUB)) SUB=$TR(ROOT,"^(,","")
- S LOOK=TXT,PRV=+($G(^TMP(SUB,$J,"SEL",0))),(EXACT,ABBR)=0
- S CNT=0,ORG=$$UP^XLFSTR($G(TXT)) K PARS D TOKEN^ICDTOKN(TXT,ROOT,$G(SYS),.PARS)
- N I,TMP S NUM=0,(PRIME,KEY,TMP)="",I=0 F S I=$O(PARS(I)) Q:+I'>0 D
- . N TX S TX=$G(PARS(I)) S:$L(TX)>$L(TMP) TMP=TX,NUM=I
- S:+NUM>0&($L(TMP)) (PRIME,KEY)=TMP S:+($G(PARS(+NUM,"A")))>0 ABBR=1
- I NUM'>0 S NUM=$O(PARS(0)),(PRIME,KEY)=$G(PARS(+NUM)) S:+($G(PARS(+NUM,"A")))>0 ABBR=1
- K:NUM>0 PARS(+NUM) S:NUM>0&($G(PARS(0))>0) PARS(0)=$G(PARS(0))-1 Q:$L(KEY)'>1
- S EROOT=ROOT_"""D""," S:+($G(SYS))>0&($D(@(ROOT_"""AD"","_+($G(SYS))_")"))) EROOT=ROOT_"""AD"","_+($G(SYS))_","
- S EXACT=0 I $O(PARS(0))'>0,$L(PRIME),$D(@(EROOT_""""_PRIME_""")")) S EXACT=1
- I EXACT>0!(ABBR>0) D
- . N ORD,STR,TKN S STR=PRIME F TKN=STR,(STR_"S"),(STR_"ES") D
- . . S ORD=TKN I $D(@(EROOT_""""_ORD_""")")) D TXT2
- I (EXACT'>0&(ABBR'>0))!('$D(^TMP(SUB,$J,"FND"))) D
- . N I S I=0 F S I=$O(PARS(+I)) Q:+I'>0 K PARS(+I,"A")
- . N ORD,STR,TKN S STR=PRIME F TKN=STR,(STR_"S"),(STR_"ES") D
- . . S ORD=$E(TKN,1,($L(TKN)-1))_$C(($A($E(TKN,$L(TKN)))-1))_"~"
- . . F S ORD=$O(@(EROOT_""""_ORD_""")")) Q:'$$ISORD^ICDEXLK3 D TXT2
- D:$D(^TMP(SUB,$J,"FND")) SEL^ICDEXLK5(ROOT,0)
- Q
- TXT2 ; Lookup by Text (loop)
- N IEN S IEN=0 F S IEN=$O(@(EROOT_""""_ORD_""","_+IEN_")")) Q:+IEN'>0 D
- . N OK,NUM,TDT,TIE,TXT,KEY,VDT S VDT=+CDT+.000001
- . S TDT=$O(@(EROOT_""""_ORD_""","_+IEN_","_VDT_")"),-1)
- . I +($G(VER))'>0,TDT'?7N D
- . . S TDT=$O(@(EROOT_""""_ORD_""","_+IEN_","_(+CDT-.000001)_")"))
- . Q:TDT'?7N S TIE=$O(@(EROOT_""""_ORD_""","_+IEN_","_+TDT_",0)"))
- . S TXT=$$UP^XLFSTR($G(@(ROOT_+IEN_",68,"_+TIE_",1)")))
- . I $G(DIC(0))'["A",$G(DIC(0))["O" D Q
- . . Q:CNT>1 I ORG=TXT D FND^ICDEXLK5(ROOT,IEN,CDT,$G(SYS),$G(VER),0,$G(OUT)) S CNT=CNT+1
- . S OK=1,NUM=0
- . F S NUM=$O(PARS(NUM)) Q:+NUM'>0 D
- . . N EXACT,PR,OR,SP,IN,AB S PR=$G(PARS(NUM)),AB=+($G(PARS(+NUM,"A")))
- . . I AB'>0 S IN=$$IN(TXT,PR),SP=$$SI(ROOT,+IEN,+TIE,PR)
- . . I AB>0 S IN=$$EX(TXT,PR),SP=$$SE(ROOT,+IEN,+TIE,PR)
- . . S:IN'>0&(SP'>0) OK=0
- . D:+OK>0 FND^ICDEXLK5(ROOT,IEN,CDT,$G(SYS),$G(VER),0,$G(OUT))
- Q
- ;
- ; Miscellaneous
- SE(RT,IE,TI,X) ; Supplemental Word (exact match exist)
- N CNTL,IIEN,PLUR,TEXT,ROOT,TIEN
- S CNTL=$$UP^XLFSTR($G(X)) Q:'$L(CNTL) 0
- S ROOT=$$ROOT^ICDEX($G(RT)) Q:'$L(ROOT) 0
- S IIEN=+($G(IE)),TIEN=+($G(TI))
- S TEXT=$$UP^XLFSTR($G(@(ROOT_+IIEN_",68,"_+TIEN_",1)"))) Q:'$L(TEXT) 0
- Q:'$D(@(ROOT_+IIEN_",68,"_+TIEN_",2,""B"","""_CNTL_""")")) 0
- S PLUR=$$EX(TEXT,(CNTL_"S")) Q:PLUR>0 0
- Q 1
- SI(RT,IE,TI,X) ; Supplemental Word (match exist)
- N CNTL,IIEN,PLUR,TEXT,NEXT,TIEN,ORDR,ROOT
- S CNTL=$$UP^XLFSTR($G(X)) Q:'$L(CNTL) 0
- S ROOT=$$ROOT^ICDEX($G(RT)) Q:'$L(ROOT) 0
- S IIEN=+($G(IE)),TIEN=+($G(TI))
- S:CNTL?1N.N ORDR=CNTL-.00000000000000009 I CNTL'?1N.N D
- . S:$L(CNTL)=1 ORDR=$C($A(CNTL)-1)_"~"
- . S:$L(CNTL)>1 ORDR=$E(CNTL,1,($L(CNTL)-1))_$C($A($E(CNTL,$L(CNTL)))-1)_"~"
- S NEXT=$O(@(ROOT_+IIEN_",68,"_+TIEN_",2,""B"","""_ORDR_""")"))
- Q:$E(NEXT,1,$L(CNTL))=CNTL 1
- Q 0
- EX(X,Y) ; String Y is exactly in X
- N CON,CNTL,TEXT,EXACT S TEXT=$G(X),CNTL=$G(Y),EXACT=1
- S CON=$$CON(TEXT,CNTL) S X=+($G(CON))
- Q X
- IN(X,Y) ; String Y is contained in X
- N CON,CNTL,TEXT S TEXT=$G(X),CNTL=$G(Y)
- S CON=$$CON(TEXT,CNTL) S X=+($G(CON))
- Q X
- CON(X,Y) ; Text X Contains String Y
- N CNTL,CONT,TEXT,LEAD,TRAIL,STR
- S TEXT=$$UP^XLFSTR($G(X)),CNTL=$$UP^XLFSTR($G(Y))
- Q:'$L(TEXT) 0 Q:'$L(CNTL) 0 Q:$L(CNTL)>$L(TEXT) 0
- S (X,CONT)=0 I +($G(EXACT))>0 S X=0 D Q X
- . F TRAIL=" ","/","-","(","<","{","[","," D Q:CONT>0
- . . N STR S STR=CNTL_TRAIL S:$E(TEXT,1,$L(STR))=STR CONT=1 S:CONT>0 X=CONT
- . Q:CONT>0 F LEAD=" ","/","-","(","<","{","[","," D Q:CONT>0
- . . N STR S STR=LEAD_CNTL S:$E(TEXT,($L(TEXT)-$L(STR)),$L(TEXT))=STR CONT=1 S:CONT>0 X=CONT
- . Q:CONT>0 F LEAD=" ","/","-","(","<","{","[","," D Q:CONT>0
- . . F TRAIL=" ","-",")",">","}","]","," D Q:CONT>0
- . . . N STR S STR=LEAD_CNTL_TRAIL S:TEXT[STR CONT=1 S:CONT>0 X=CONT
- . S:CONT>0 X=CONT
- S:$E(TEXT,1,$L(CNTL))=CNTL CONT=1
- S:CONT>0 X=CONT Q:CONT>0 X
- F LEAD=" ","/","-","(","<","{","[","," D Q:CONT>0
- . N STR S STR=LEAD_CNTL S:TEXT[STR CONT=1 S:CONT>0 X=CONT
- Q:CONT>0 X F LEAD=" ","/","-","(","<","{","[","," D Q:CONT>0
- . N TRAIL F TRAIL=" ","-",")",">","}","]","," D Q:CONT>0
- . . N STR S STR=LEAD_CNTL_TRAIL S:TEXT[STR CONT=1 S:CONT>0 X=CONT
- S:CONT>0 X=CONT
- Q X
- LC(X) ; Leading Character
- S X=$G(X) S X=$$UP^XLFSTR($E(X,1))_$$LOW^XLFSTR($E(X,2,$L(X)))
- Q X
- SS ; Show Select/Find Global Arrays
- N NN,NC,EX S EX=0 S NN="^TMP(""ICD9"","_$J_")",NC="^TMP(""ICD9"","_$J_","
- F S NN=$Q(@NN) Q:'$L(NN)!(NN'[NC) D Q:EX>20
- . W !,NN,"=",$E(@NN,1,48) S EX=EX+1
- S EX=0 S NN="^TMP(""ICD0"","_$J_")",NC="^TMP(""ICD0"","_$J_","
- F S NN=$Q(@NN) Q:'$L(NN)!(NN'[NC) D Q:EX>20
- . W !,NN,"=",$E(@NN,1,48) S EX=EX+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDEXLK4 5870 printed Mar 13, 2025@20:55:24 Page 2
- ICDEXLK4 ;SLC/KER - ICD Extractor - Lookup, Search Text ;12/19/2014
- +1 ;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21
- +2 ;
- +3 ; Global Variables
- +4 ; ^TMP(SUB,$J SACC 2.3.2.5.1
- +5 ;
- +6 ; External References
- +7 ; $$LOW^XLFSTR ICR 10104
- +8 ; $$UP^XLFSTR ICR 10104
- +9 ;
- +10 ; Local Variables Newed or Killed by calling application
- +11 ; DIC(0) Fileman Lookup Parameters
- +12 ;
- +13 ; Local Variables Newed or Killed Elsewhere
- +14 ; ICDBYCD Sort by Code
- +15 ; CDT Code Set Date
- +16 ; OUT Format of display
- +17 ; SYS Coding System
- +18 ; VER Versioned Lookup
- +19 ; SUB ^TMP Subscript
- +20 ; SYS Coding System
- +21 ;
- TXT ; Lookup by Text (Requires TXT and ROOT)
- +1 if $DATA(ICDBYCD)
- QUIT
- if '$LENGTH($GET(TXT))
- QUIT
- if '$LENGTH($GET(ROOT))
- QUIT
- if $LENGTH(TXT)'>1
- QUIT
- if $GET(DIC(0))["B"
- QUIT
- +2 SET CDT=$$CDT^ICDEXLK3($GET(CDT))
- NEW PARS,ORG,CNT,PRV,EROOT,KEY,LOOK,EXACT,ABBR,PRIME
- +3 if '$LENGTH($GET(SUB))
- SET SUB=$TRANSLATE(ROOT,"^(,","")
- +4 SET LOOK=TXT
- SET PRV=+($GET(^TMP(SUB,$JOB,"SEL",0)))
- SET (EXACT,ABBR)=0
- +5 SET CNT=0
- SET ORG=$$UP^XLFSTR($GET(TXT))
- KILL PARS
- DO TOKEN^ICDTOKN(TXT,ROOT,$GET(SYS),.PARS)
- +6 NEW I,TMP
- SET NUM=0
- SET (PRIME,KEY,TMP)=""
- SET I=0
- FOR
- SET I=$ORDER(PARS(I))
- if +I'>0
- QUIT
- Begin DoDot:1
- +7 NEW TX
- SET TX=$GET(PARS(I))
- if $LENGTH(TX)>$LENGTH(TMP)
- SET TMP=TX
- SET NUM=I
- End DoDot:1
- +8 if +NUM>0&($LENGTH(TMP))
- SET (PRIME,KEY)=TMP
- if +($GET(PARS(+NUM,"A")))>0
- SET ABBR=1
- +9 IF NUM'>0
- SET NUM=$ORDER(PARS(0))
- SET (PRIME,KEY)=$GET(PARS(+NUM))
- if +($GET(PARS(+NUM,"A")))>0
- SET ABBR=1
- +10 if NUM>0
- KILL PARS(+NUM)
- if NUM>0&($GET(PARS(0))>0)
- SET PARS(0)=$GET(PARS(0))-1
- if $LENGTH(KEY)'>1
- QUIT
- +11 SET EROOT=ROOT_"""D"","
- if +($GET(SYS))>0&($DATA(@(ROOT_"""AD"","_+($GET(SYS))_")")))
- SET EROOT=ROOT_"""AD"","_+($GET(SYS))_","
- +12 SET EXACT=0
- IF $ORDER(PARS(0))'>0
- IF $LENGTH(PRIME)
- IF $DATA(@(EROOT_""""_PRIME_""")"))
- SET EXACT=1
- +13 IF EXACT>0!(ABBR>0)
- Begin DoDot:1
- +14 NEW ORD,STR,TKN
- SET STR=PRIME
- FOR TKN=STR,(STR_"S"),(STR_"ES")
- Begin DoDot:2
- +15 SET ORD=TKN
- IF $DATA(@(EROOT_""""_ORD_""")"))
- DO TXT2
- End DoDot:2
- End DoDot:1
- +16 IF (EXACT'>0&(ABBR'>0))!('$DATA(^TMP(SUB,$JOB,"FND")))
- Begin DoDot:1
- +17 NEW I
- SET I=0
- FOR
- SET I=$ORDER(PARS(+I))
- if +I'>0
- QUIT
- KILL PARS(+I,"A")
- +18 NEW ORD,STR,TKN
- SET STR=PRIME
- FOR TKN=STR,(STR_"S"),(STR_"ES")
- Begin DoDot:2
- +19 SET ORD=$EXTRACT(TKN,1,($LENGTH(TKN)-1))_$CHAR(($ASCII($EXTRACT(TKN,$LENGTH(TKN)))-1))_"~"
- +20 FOR
- SET ORD=$ORDER(@(EROOT_""""_ORD_""")"))
- if '$$ISORD^ICDEXLK3
- QUIT
- DO TXT2
- End DoDot:2
- End DoDot:1
- +21 if $DATA(^TMP(SUB,$JOB,"FND"))
- DO SEL^ICDEXLK5(ROOT,0)
- +22 QUIT
- TXT2 ; Lookup by Text (loop)
- +1 NEW IEN
- SET IEN=0
- FOR
- SET IEN=$ORDER(@(EROOT_""""_ORD_""","_+IEN_")"))
- if +IEN'>0
- QUIT
- Begin DoDot:1
- +2 NEW OK,NUM,TDT,TIE,TXT,KEY,VDT
- SET VDT=+CDT+.000001
- +3 SET TDT=$ORDER(@(EROOT_""""_ORD_""","_+IEN_","_VDT_")"),-1)
- +4 IF +($GET(VER))'>0
- IF TDT'?7N
- Begin DoDot:2
- +5 SET TDT=$ORDER(@(EROOT_""""_ORD_""","_+IEN_","_(+CDT-.000001)_")"))
- End DoDot:2
- +6 if TDT'?7N
- QUIT
- SET TIE=$ORDER(@(EROOT_""""_ORD_""","_+IEN_","_+TDT_",0)"))
- +7 SET TXT=$$UP^XLFSTR($GET(@(ROOT_+IEN_",68,"_+TIE_",1)")))
- +8 IF $GET(DIC(0))'["A"
- IF $GET(DIC(0))["O"
- Begin DoDot:2
- +9 if CNT>1
- QUIT
- IF ORG=TXT
- DO FND^ICDEXLK5(ROOT,IEN,CDT,$GET(SYS),$GET(VER),0,$GET(OUT))
- SET CNT=CNT+1
- End DoDot:2
- QUIT
- +10 SET OK=1
- SET NUM=0
- +11 FOR
- SET NUM=$ORDER(PARS(NUM))
- if +NUM'>0
- QUIT
- Begin DoDot:2
- +12 NEW EXACT,PR,OR,SP,IN,AB
- SET PR=$GET(PARS(NUM))
- SET AB=+($GET(PARS(+NUM,"A")))
- +13 IF AB'>0
- SET IN=$$IN(TXT,PR)
- SET SP=$$SI(ROOT,+IEN,+TIE,PR)
- +14 IF AB>0
- SET IN=$$EX(TXT,PR)
- SET SP=$$SE(ROOT,+IEN,+TIE,PR)
- +15 if IN'>0&(SP'>0)
- SET OK=0
- End DoDot:2
- +16 if +OK>0
- DO FND^ICDEXLK5(ROOT,IEN,CDT,$GET(SYS),$GET(VER),0,$GET(OUT))
- End DoDot:1
- +17 QUIT
- +18 ;
- +19 ; Miscellaneous
- SE(RT,IE,TI,X) ; Supplemental Word (exact match exist)
- +1 NEW CNTL,IIEN,PLUR,TEXT,ROOT,TIEN
- +2 SET CNTL=$$UP^XLFSTR($GET(X))
- if '$LENGTH(CNTL)
- QUIT 0
- +3 SET ROOT=$$ROOT^ICDEX($GET(RT))
- if '$LENGTH(ROOT)
- QUIT 0
- +4 SET IIEN=+($GET(IE))
- SET TIEN=+($GET(TI))
- +5 SET TEXT=$$UP^XLFSTR($GET(@(ROOT_+IIEN_",68,"_+TIEN_",1)")))
- if '$LENGTH(TEXT)
- QUIT 0
- +6 if '$DATA(@(ROOT_+IIEN_",68,"_+TIEN_",2,""B"","""_CNTL_""")"))
- QUIT 0
- +7 SET PLUR=$$EX(TEXT,(CNTL_"S"))
- if PLUR>0
- QUIT 0
- +8 QUIT 1
- SI(RT,IE,TI,X) ; Supplemental Word (match exist)
- +1 NEW CNTL,IIEN,PLUR,TEXT,NEXT,TIEN,ORDR,ROOT
- +2 SET CNTL=$$UP^XLFSTR($GET(X))
- if '$LENGTH(CNTL)
- QUIT 0
- +3 SET ROOT=$$ROOT^ICDEX($GET(RT))
- if '$LENGTH(ROOT)
- QUIT 0
- +4 SET IIEN=+($GET(IE))
- SET TIEN=+($GET(TI))
- +5 if CNTL?1N.N
- SET ORDR=CNTL-.00000000000000009
- IF CNTL'?1N.N
- Begin DoDot:1
- +6 if $LENGTH(CNTL)=1
- SET ORDR=$CHAR($ASCII(CNTL)-1)_"~"
- +7 if $LENGTH(CNTL)>1
- SET ORDR=$EXTRACT(CNTL,1,($LENGTH(CNTL)-1))_$CHAR($ASCII($EXTRACT(CNTL,$LENGTH(CNTL)))-1)_"~"
- End DoDot:1
- +8 SET NEXT=$ORDER(@(ROOT_+IIEN_",68,"_+TIEN_",2,""B"","""_ORDR_""")"))
- +9 if $EXTRACT(NEXT,1,$LENGTH(CNTL))=CNTL
- QUIT 1
- +10 QUIT 0
- EX(X,Y) ; String Y is exactly in X
- +1 NEW CON,CNTL,TEXT,EXACT
- SET TEXT=$GET(X)
- SET CNTL=$GET(Y)
- SET EXACT=1
- +2 SET CON=$$CON(TEXT,CNTL)
- SET X=+($GET(CON))
- +3 QUIT X
- IN(X,Y) ; String Y is contained in X
- +1 NEW CON,CNTL,TEXT
- SET TEXT=$GET(X)
- SET CNTL=$GET(Y)
- +2 SET CON=$$CON(TEXT,CNTL)
- SET X=+($GET(CON))
- +3 QUIT X
- CON(X,Y) ; Text X Contains String Y
- +1 NEW CNTL,CONT,TEXT,LEAD,TRAIL,STR
- +2 SET TEXT=$$UP^XLFSTR($GET(X))
- SET CNTL=$$UP^XLFSTR($GET(Y))
- +3 if '$LENGTH(TEXT)
- QUIT 0
- if '$LENGTH(CNTL)
- QUIT 0
- if $LENGTH(CNTL)>$LENGTH(TEXT)
- QUIT 0
- +4 SET (X,CONT)=0
- IF +($GET(EXACT))>0
- SET X=0
- Begin DoDot:1
- +5 FOR TRAIL=" ","/","-","(","<","{","[",","
- Begin DoDot:2
- +6 NEW STR
- SET STR=CNTL_TRAIL
- if $EXTRACT(TEXT,1,$LENGTH(STR))=STR
- SET CONT=1
- if CONT>0
- SET X=CONT
- End DoDot:2
- if CONT>0
- QUIT
- +7 if CONT>0
- QUIT
- FOR LEAD=" ","/","-","(","<","{","[",","
- Begin DoDot:2
- +8 NEW STR
- SET STR=LEAD_CNTL
- if $EXTRACT(TEXT,($LENGTH(TEXT)-$LENGTH(STR)),$LENGTH(TEXT))=STR
- SET CONT=1
- if CONT>0
- SET X=CONT
- End DoDot:2
- if CONT>0
- QUIT
- +9 if CONT>0
- QUIT
- FOR LEAD=" ","/","-","(","<","{","[",","
- Begin DoDot:2
- +10 FOR TRAIL=" ","-",")",">","}","]",","
- Begin DoDot:3
- +11 NEW STR
- SET STR=LEAD_CNTL_TRAIL
- if TEXT[STR
- SET CONT=1
- if CONT>0
- SET X=CONT
- End DoDot:3
- if CONT>0
- QUIT
- End DoDot:2
- if CONT>0
- QUIT
- +12 if CONT>0
- SET X=CONT
- End DoDot:1
- QUIT X
- +13 if $EXTRACT(TEXT,1,$LENGTH(CNTL))=CNTL
- SET CONT=1
- +14 if CONT>0
- SET X=CONT
- if CONT>0
- QUIT X
- +15 FOR LEAD=" ","/","-","(","<","{","[",","
- Begin DoDot:1
- +16 NEW STR
- SET STR=LEAD_CNTL
- if TEXT[STR
- SET CONT=1
- if CONT>0
- SET X=CONT
- End DoDot:1
- if CONT>0
- QUIT
- +17 if CONT>0
- QUIT X
- FOR LEAD=" ","/","-","(","<","{","[",","
- Begin DoDot:1
- +18 NEW TRAIL
- FOR TRAIL=" ","-",")",">","}","]",","
- Begin DoDot:2
- +19 NEW STR
- SET STR=LEAD_CNTL_TRAIL
- if TEXT[STR
- SET CONT=1
- if CONT>0
- SET X=CONT
- End DoDot:2
- if CONT>0
- QUIT
- End DoDot:1
- if CONT>0
- QUIT
- +20 if CONT>0
- SET X=CONT
- +21 QUIT X
- LC(X) ; Leading Character
- +1 SET X=$GET(X)
- SET X=$$UP^XLFSTR($EXTRACT(X,1))_$$LOW^XLFSTR($EXTRACT(X,2,$LENGTH(X)))
- +2 QUIT X
- SS ; Show Select/Find Global Arrays
- +1 NEW NN,NC,EX
- SET EX=0
- SET NN="^TMP(""ICD9"","_$JOB_")"
- SET NC="^TMP(""ICD9"","_$JOB_","
- +2 FOR
- SET NN=$QUERY(@NN)
- if '$LENGTH(NN)!(NN'[NC)
- QUIT
- Begin DoDot:1
- +3 WRITE !,NN,"=",$EXTRACT(@NN,1,48)
- SET EX=EX+1
- End DoDot:1
- if EX>20
- QUIT
- +4 SET EX=0
- SET NN="^TMP(""ICD0"","_$JOB_")"
- SET NC="^TMP(""ICD0"","_$JOB_","
- +5 FOR
- SET NN=$QUERY(@NN)
- if '$LENGTH(NN)!(NN'[NC)
- QUIT
- Begin DoDot:1
- +6 WRITE !,NN,"=",$EXTRACT(@NN,1,48)
- SET EX=EX+1
- End DoDot:1
- if EX>20
- QUIT
- +7 QUIT
