AICDEFDX.m

AICDEFDX ; IHS/OHPRD/ACC - EDIT FREQUENTLY USED DX NARR ;

 ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991

 S DIE="^AICDKWLC("

 S DA=$O(^AICDKWLC("B","DIAGNOSES","")) I 'DA W *7,"-- No DIAGNOSES subfile in KEYWORD LOOKUP CONTROL file",! Q

 S DR="3"

 D ^DIE

 Q

AICDEFDX  ; IHS/OHPRD/ACC - EDIT FREQUENTLY USED DX NARR ;

 +1       ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991

 +2        SET DIE="^AICDKWLC("

 +3        SET DA=$ORDER(^AICDKWLC("B","DIAGNOSES",""))

           IF 'DA

               WRITE *7,"-- No DIAGNOSES subfile in KEYWORD LOOKUP CONTROL file",!

               QUIT 

 +4        SET DR="3"

 +5        DO ^DIE

 +6        QUIT