Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AICDADK

AICDADK.m

Go to the documentation of this file.
  1. AICDADK ; IHS/OHPRD/ACC - ADD KEYWORDS TO "OTHER KEYWORDS" FIELD IN ^ICD0/9 ;
  1. ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991
  1. W !!,*7,"AICDADK CANNOT BE ENTERED AT THE TOP -- USE DX OR OP",!!
  1. Q
  1. DX S AICDGBL="^ICD9"
  1. G INIT
  1. OP S AICDGBL="^ICD0"
  1. INIT D ^%AUKVAR S AICDBB=$C(7),AICDFLD="9999999.21",AICDLAST=""
  1. S AICDNWS=^DD("KWIC")_"IN^OF^AN^IS^AS^AT^IF^IT^ON^OR^BY^"
  1. W "- - - Add keywords to ",$P(@AICDGBL@(0),U,1)," ""OTHER KEYWORDS"" field - - -",!!
  1. MAINLP F AICDQ=0:0 R "Code: ",AICDCODE:DTIME S:'$T AICDCODE=U Q:U[AICDCODE S:AICDCODE=" " AICDCODE=AICDLAST S AICDLAST=AICDCODE D GCODE
  1. W !
  1. K AICDCODE,AICDNUMB,AICDBB,AICDFLD,AICDGBL,AICDSQN,AICDCNT,AICDDFN,AICDCDFN,AICDL,AICDNW,AICDWT,AICDWD,AICDWC,AICDWF,AICDWSV,AICDWS,AICDW,AICDNWS,AICDQ,AICDI,AICDA,AICDLAST,AICDEXEC
  1. W !,"B y e . . .",!
  1. Q
  1. ;
  1. GCODE ; GOT CODE
  1. D CHKCODE^AICDADK1 I AICDCODE="" W AICDBB," -- Invalid ICD code format",! Q
  1. S AICDCDFN=""
  1. I $D(@AICDGBL@("AB",AICDCODE)) S AICDCDFN=$O(^(AICDCODE,"")) W " ",@AICDGBL@(AICDCDFN,1),! S AICDNUMB=AICDCODE D GETKWD^AICDADK1,SET^AICDADK1 Q
  1. S AICDNUMB=$O(@AICDGBL@("BA",AICDCODE_" "))
  1. I $E(AICDNUMB,1,$L(AICDCODE))'=AICDCODE S AICDCODE="" W AICDBB," -- Code does not exist and has no more specific descendents.",! Q
  1. W !," Code does not exist as entered, but has descendents."
  1. R !," Do you wish to add keywords to the more specific subcodes? Y// ",AICDA:DTIME,! S:'$T AICDA=U
  1. Q:"Yy"'[$E(AICDA_"Y")
  1. D GETKWD^AICDADK1
  1. S AICDNUMB=AICDCODE
  1. I AICDCODE'=+AICDCODE D NONCON^AICDADK1 Q
  1. D CANONIC^AICDADK1
  1. Q