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

BSTSMAP1.m

Go to the documentation of this file. 
  1. BSTSMAP1 ;GDIT/HS/BEE-Standard Terminology API Program - Mapping Logic ; 5 Nov 2012  9:53 AM
  1.  ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
  1.  ;
  1.  Q
  1.  ;
  1. SAVEMAP(CONCDA,BSTSC,GL) ;Save ICD10 Condition Map Rules
  1.  ;
  1.  ;Called by UPDATE^BSTSDTS0
  1.  ;
  1.  Q:CONCDA=""
  1.  Q:GL=""
  1.  ;
  1.  ;Clear out existing entries
  1.  D
  1.  . NEW MP
  1.  . S MP=0 F  S MP=$O(^BSTS(9002318.4,CONCDA,14,MP)) Q:'MP  D
  1.  .. NEW DA,DIK
  1.  .. S DA(1)=CONCDA,DA=MP
  1.  .. S DIK="^BSTS(9002318.4,"_DA(1)_",14," D ^DIK
  1.  ;
  1.  ;Now save mappings
  1.  I $D(@GL@("A10C"))>1 D
  1.  . ;
  1.  . NEW MG,MP,MC
  1.  . S MG="" F  S MG=$O(@GL@("A10C",MG)) Q:MG=""  S MP="" F  S MP=$O(@GL@("A10C",MG,MP)) Q:MP=""  S MC="" F  S MC=$O(@GL@("A10C",MG,MP,MC)) Q:MC=""  D
  1.  .. ;
  1.  .. NEW DIC,X,Y,DA,IENS,DLAYGO,NODE,MICD,PC,CNDLST,COND,RULE
  1.  .. S NODE=$G(@GL@("A10C",MG,MP,MC))
  1.  .. S MICD=$P(NODE,U) Q:MICD=""  ;Get mapped ICD
  1.  .. S CNDLST=$P(NODE,U,2)
  1.  .. S DA(1)=CONCDA
  1.  .. S DIC(0)="LX",DIC="^BSTS(9002318.4,"_DA(1)_",14,"
  1.  .. S X=MC
  1.  .. S DLAYGO=9002318.414 D ^DIC
  1.  .. ;
  1.  .. ;Quit on fail
  1.  .. I +Y<0 Q
  1.  .. ;
  1.  .. ;Save remaining fields
  1.  .. S (RULE,DA)=+Y,IENS=$$IENS^DILF(.DA)
  1.  .. S BSTSC(9002318.414,IENS,".02")=MG
  1.  .. S BSTSC(9002318.414,IENS,".03")=MP
  1.  .. S BSTSC(9002318.414,IENS,".04")=MICD
  1.  .. ;
  1.  .. ;Save Conditions
  1.  .. F PC=1:1:$L(CNDLST,";") S COND=$P(CNDLST,";",PC) D
  1.  ... ;
  1.  ... I PC>1,COND="" Q
  1.  ... ;
  1.  ... NEW VAR,OPER,VALUE,DA,IENS,DIC,DLAYGO,X,Y
  1.  ... ;
  1.  ... ;Handle Unconditionals
  1.  ... S:COND="" COND="TRUE = 1"
  1.  ... S VAR=$P(COND," ")  ;Condition
  1.  ... S OPER=$P(COND," ",2)  ;Operator
  1.  ... S VALUE=$P(COND," ",3,99)  ;Value
  1.  ... ;
  1.  ... ;Special variable handling
  1.  ... I VAR="AAO",VALUE[" days" S VAR="AAOD",VALUE=$P(VALUE," ")
  1.  ... I VAR="AAO",VALUE[" years" S VAR="AAOY",VALUE=$P(VALUE," ")
  1.  ... S DA(2)=CONCDA,DA(1)=RULE
  1.  ... S X=VAR,DIC(0)="LX",DIC="^BSTS(9002318.4,"_DA(2)_",14,"_DA(1)_",1,"
  1.  ... S DLAYGO=9002318.4141
  1.  ... K DO,DD D FILE^DICN
  1.  ... I +Y<0 Q
  1.  ... S DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  ... ;
  1.  ... ;Save remaining fields
  1.  ... S BSTSC(9002318.4141,IENS,.02)=OPER
  1.  ... S BSTSC(9002318.4141,IENS,.03)=VALUE
  1.  ... S BSTSC(9002318.4141,IENS,.04)=COND
  1.  ;
  1.  ;Capture the status
  1.  I $D(@GL@("CSTS")) D
  1.  . NEW CSTS,CIEN
  1.  . S CIEN=$O(@GL@("CSTS","")) Q:CIEN=""
  1.  . S CSTS=$P($G(@GL@("CSTS",CIEN)),U) S:CSTS="" CSTS="@"
  1.  . S BSTSC(9002318.4,CONCDA_",",.14)=CSTS
  1.  ;
  1.  Q
  1.  ;
  1. PLIST(CONCID) ;Return conditional parameters used for that concepts conditional logic
  1.  ;
  1.  I $G(CONCID)="" Q ""
  1.  ;
  1.  NEW VAR,RETURN
  1.  ;
  1.  ;Compile list of parameters that are used
  1.  S (RETURN,VAR)="" F  S VAR=$O(^BSTS(9002318.4,"J",36,CONCID,VAR)) Q:VAR=""  D
  1.  . S RETURN=RETURN_$S(RETURN]"":"^",1:"")_VAR
  1.  ;
  1.  ;Return List
  1.  Q RETURN
  1.  ;
  1.  ;Return AAOD
  1. AAOD(VIEN) ;Return Age in Days
  1.  ;
  1.  ;Input: VIEN - The visit IEN
  1.  ;
  1.  Q:VIEN="" ""
  1.  ;
  1.  NEW AAOD,DOB,VDT,DFN,X1,X2,X,%Y
  1.  ;
  1.  S AAOD=""
  1.  ;
  1.  ;Visit Date
  1.  S VDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I") Q:VDT="" ""
  1.  ;
  1.  ;Date of Birth
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") Q:DFN="" ""
  1.  S DOB=$$GET1^DIQ(2,DFN,.03,"I") Q:DOB="" ""
  1.  ;
  1.  ;Get difference in dates in days
  1.  S X2=DOB,X1=VDT D ^%DTC
  1.  I +X>0 S AAOD=+X
  1.  ;
  1.  Q AAOD
  1.  ;
  1.  ;Return AAOY
  1. AAOY(VIEN) ;Return Age in Years
  1.  ;
  1.  ;Input: VIEN - The visit IEN
  1.  ;
  1.  Q:VIEN="" ""
  1.  ;
  1.  NEW AAOY,DOB,VDT,DFN,X1,X2,X,%Y
  1.  ;
  1.  S AAOY=""
  1.  ;
  1.  ;Visit Date
  1.  S VDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I") Q:VDT="" ""
  1.  ;
  1.  ;Date of Birth
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") Q:DFN="" ""
  1.  ;
  1.  ;Get the Age in Years
  1.  S AAOY=$$GET1^DIQ(2,DFN,.033,"E")
  1.  ;
  1.  Q AAOY
  1.  ;
  1. AC(CONC) ;Return Acute/Chronic value for the concept
  1.  ;
  1.  I $G(CONC)="" Q ""
  1.  ;
  1.  NEW STS,CIEN
  1.  ;
  1.  ;Get the internal CIEN
  1.  S CIEN=$O(^BSTS(9002318.4,"C",36,CONC,"")) Q:CIEN=""
  1.  ;
  1.  ;Pull the status from local cache
  1.  S STS=$$GET1^DIQ(9002318.4,CIEN_",",.14,"I")
  1.  S STS=$S(STS="A":"Acute",STS="C":"Chronic",1:"")
  1.  Q STS
  1.  ;
  1. SEX(VIEN) ;Return patient sex
  1.  ;
  1.  ;Input: VIEN - The visit IEN
  1.  ;
  1.  I $G(VIEN)="" Q ""
  1.  ;
  1.  NEW DFN,SEX
  1.  ;
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") Q:DFN="" ""
  1.  S SEX=$$GET1^DIQ(2,DFN,.02,"I")
  1.  S SEX=$S(SEX="M":"Male",SEX="F":"Female",1:"")
  1.  ;
  1.  Q SEX
  1.  ;
  1.  ;Return Converted Parameter Value for Mapping
  1. CVPARM(TYPE,PARM) ;Return the converted value
  1.  ;
  1.  I $G(PARM)="" Q ""
  1.  I $G(TYPE)="" Q ""
  1.  ;
  1.  ;Look for a mapping translation in BSTS SNOMED MAPPING CONV
  1.  S PARM=$O(^BSTS(9002318.6,"C",TYPE,PARM,""))
  1.  ;
  1.  ;Return the translated value
  1.  Q PARM
  1.  ;
  1. TRI(VIEN) ;Return Trimester
  1.  ;
  1.  ;Input: VIEN - The visit IEN
  1.  ;
  1.  I $G(VIEN)="" Q ""
  1.  ;
  1.  NEW DFN,TRI
  1.  ;
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") Q:DFN="" ""
  1.  ;
  1.  ;Return the trimester in weeks
  1.  S TRI=$$LASTMSR^BSTSMSR($G(DFN),"EGA",0,0)
  1.  ;
  1.  ;Convert to weeks
  1.  I +TRI'>0 S TRI="" ;No trimester
  1.  E  I +TRI<14 S TRI="First"
  1.  E  I +TRI<28 S TRI="Second"
  1.  E  S TRI="Third"
  1.  ;
  1.  Q TRI
  1.  ;
  1. BMI(VIEN) ;Return BMI
  1.  ;
  1.  ;Input: VIEN - The visit IEN
  1.  ;
  1.  I $G(VIEN)="" Q ""
  1.  ;
  1.  NEW DFN,BMI
  1.  ;
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I") Q:DFN="" 0
  1.  ;
  1.  ;Return the latest BMI
  1.  S BMI=$$LASTMSR^BSTSMSR($G(DFN),"BMI",0,0)
  1.  ;
  1.  ;Handle no BMI
  1.  I +BMI'>0 S BMI=""
  1.  ;
  1.  Q BMI
  1.  ;
  1. AF(AF) ;Return Abnormal Findings
  1.  ;
  1.  I $G(AF)="" Q ""
  1.  ;
  1.  ;Handle invalid AF entries
  1.  Q $S(AF="With":AF,AF="Without":AF,1:"")
  1.  ;
  1. HEAL(HEAL) ;Fracture Healing
  1.  ;
  1.  I $G(HEAL)="" Q ""
  1.  ;
  1.  ;Handle invalid HEAL entries
  1.  Q $S(HEAL="Routine":"NL Union",1:HEAL)
  1.  ;
  1. LAT(PRB,FH) ;Return Laterality
  1.  ;
  1.  I $G(PRB)="",$G(FH)="" Q ""
  1.  ;
  1.  NEW LAT,ATR
  1.  ;
  1.  ;Pull laterality from the PROBLEM file or FAMILY HISTORY file
  1.  S LAT=""
  1.  I PRB]"" S LAT=$$GET1^DIQ(9000011,PRB_",",".22","I")
  1.  I FH]"",LAT="" S LAT=$$GET1^DIQ(9000014,FH_",",".17","I")
  1.  Q:$TR(LAT,"|")="" ""
  1.  ;
  1.  ;Quit if attribute not "Laterality"
  1.  S ATR=$P(LAT,"|") Q:ATR="" ""
  1.  S LAT=$P(LAT,"|",2) Q:LAT="" ""
  1.  I ATR?1N.N,$O(^BSTS(9002318.6,"C","LAT",ATR,""))'="Laterality" Q ""
  1.  I ATR'?1N.N,ATR'="Laterality" Q
  1.  ;
  1.  ;If SNOMED, convert and return
  1.  I LAT?1N.N S LAT=$$CVPARM("LAT",LAT) Q $S(LAT="Right and left":"Bilateral",1:LAT)
  1.  ;
  1.  ;If text, convert Right and left -> Bilateral
  1.  Q $S(LAT="Right and left":"Bilateral",1:LAT)
  1.  ;
  1. SEV(PRB) ;Return Severity
  1.  ;
  1.  I $G(PRB)="" Q ""
  1.  ;
  1.  NEW SEV,I,FND
  1.  ;
  1.  ;Pull Severity from the PROBLEM file
  1.  S (SEV,FND,I)=0 F  S I=$O(^AUPNPROB(PRB,13,I)) Q:'+I  D  Q:FND
  1.  . NEW SNO
  1.  . S SNO=$P($G(^AUPNPROB(PRB,13,I,0)),U,1)
  1.  . I SNO'="",$$CVPARM^BSTSMAP1("SEV",SNO)'="Severity" S SEV=SNO,FND=1
  1.  ;
  1.  Q SEV
  1.  ;
  1. CMAP(CONC,PARMS) ;Return the conditional ICD10 mappings for a concept
  1.  ;
  1.  ;This function accepts a Concept ID and a string of parameters and based on mapping logic
  1.  ;returns the mapped ICD10 code(s) for that concept
  1.  ;
  1.  ;Input:
  1.  ; CONC - Concept ID
  1.  ; PARMS - Parameter string. Ex. "EPI=255217005;VST=2087365;PRB=123456"
  1.  ;
  1.  ;Output: Returns a ";" string of ICD10 maps to that concept
  1.  ;
  1.  ;Mapping Overview
  1.  ;Concepts with conditional mapping will have one or more map groups.  Each map group can have 0 or 1
  1.  ;ICD10 codes associated with it. A concept can therefore have more than one ICD10 mapping, up to 1
  1.  ;per map group. Within each map group there can be multiple priorities. Each priority
  1.  ;can have one or more condition checks associated with it.  The ICD10 code assigned to the first
  1.  ;priority that ALL the checks pass on will get assigned for that map group.
  1.  ;
  1.  I $G(CONC)="" Q ""  ;No Concept Id
  1.  I $G(PARMS)="" Q ""  ;No mapping parameters passed in
  1.  ;
  1.  NEW PC,VAL,FND,ICD,VAR,CDARY,MGRP,VARRAY,FH,HEAL,VDT
  1.  NEW EPI,VST,AF,SEV,PRB,OC,AAOD,AAOY,AC,BMI,SEX,LAT,TRI,TRUE
  1.  ;
  1.  ;Parse the passed in PARMS and set the variables
  1.  S (EPI,VST,AF,SEV,PRB,OC,AAOD,AAOY,AC,BMI,SEX,LAT,TRI,FH,HEAL)="",TRUE=1  ;Preset possible variables
  1.  F PC=1:1:$L(PARMS,";") S VAL=$P(PARMS,";",PC) I VAL]"" D
  1.  . ;
  1.  . ;Handle invalid parameters passed in
  1.  . I VAL'["=" Q  ;No equal sign
  1.  . I (",EPI,VST,AF,SEV,PRB,HEAL,OC,")'[(","_$P(VAL,"=")_",") Q  ;Incorrect first parameter
  1.  . I $P(VAL,"=",2)="" Q  ;Null value, already set
  1.  . ;
  1.  . ;Set the parameter variable (adding quotes)
  1.  . S VAL="S "_$P(VAL,"=")_"="_$C(34)_$P(VAL,"=",2)_$C(34)
  1.  . X VAL
  1.  ;
  1.  ;Locate the variables used by this concept
  1.  S (FND,ICD,VAR)="" F  S VAR=$O(^BSTS(9002318.4,"J",36,CONC,VAR)) Q:VAR=""  D
  1.  . ;
  1.  . ;Found a conditional map
  1.  . S FND=1
  1.  . ;
  1.  . ;Record that variable is needed for the mapping
  1.  . S VARRAY(VAR)=""
  1.  ;
  1.  ;Quit if no conditional mapping
  1.  I FND="" Q ICD
  1.  ;
  1.  ;Determine the parameter values
  1.  S VAR="" F  S VAR=$O(VARRAY(VAR)) Q:VAR=""  D
  1.  . ;
  1.  . ;Acute/Chronic
  1.  . I VAR="AC" S AC=$$AC(CONC) Q
  1.  . ;
  1.  . ;Age at onset - Days
  1.  . I VAR="AAOD" S AAOD=$$AAOD(VST) Q
  1.  . ;
  1.  . ;Age at onset - Years
  1.  . I VAR="AAOY" S AAOY=$$AAOY(VST) Q
  1.  . ;
  1.  . ;Episodicity
  1.  . I VAR="EPI" S EPI=$$CVPARM("EPI",EPI) Q
  1.  . ;
  1.  . ;Gender
  1.  . I VAR="SEX" S SEX=$$SEX(VST) Q
  1.  . ;
  1.  . ;Laterality
  1.  . I VAR="LAT" S LAT=$$LAT(PRB,FH) Q
  1.  . ;
  1.  . ;BMI
  1.  . I VAR="BMI" S BMI=$$BMI(VST) Q
  1.  . ;
  1.  . ;Trimester
  1.  . I VAR="TRI" S TRI=$$TRI(VST) Q
  1.  . ;
  1.  . ;Severity
  1.  . I VAR="SEV" D  Q
  1.  .. S:SEV="" SEV=$$SEV(PRB)
  1.  .. S SEV=$$CVPARM("SEV",SEV)
  1.  . ;
  1.  . ;Abnormal Findings
  1.  . I VAR="AF" S AF=$$AF(AF) Q
  1.  . ;
  1.  . ;Fracture Healing
  1.  . I VAR="HEAL" S HEAL=$$HEAL(HEAL) Q
  1.  ;
  1.  ;Assemble the conditions
  1.  D BCOND^BSTSMAP1(CONC,.CDARY)
  1.  ;
  1.  ;Visit Date
  1.  S VDT=$$GET1^DIQ(9000010,$G(VST)_",",.01,"I") S:VDT="" VDT=DT
  1.  ;
  1.  ;Process each group
  1.  S MGRP="" F  S MGRP=$O(CDARY(MGRP)) Q:MGRP=""  D
  1.  . ;
  1.  . NEW CNTR,GFND
  1.  . ;
  1.  . ;Loop by Counter/Priority - Quit if entry found for the group
  1.  . S (GFND,CNTR)="" F  S CNTR=$O(CDARY(MGRP,CNTR)) Q:CNTR=""  D  Q:GFND
  1.  .. ;
  1.  .. NEW COD,FAIL
  1.  .. ;
  1.  .. ;Get the code
  1.  .. S COD=$G(CDARY(MGRP,CNTR))
  1.  .. ;
  1.  .. NEW CNDCT
  1.  .. ;
  1.  .. ;Loop through each condition for the priority
  1.  .. S (FAIL,CNDCT)="" F  S CNDCT=$O(CDARY(MGRP,CNTR,CNDCT)) Q:CNDCT=""  D  Q:FAIL
  1.  ... ;
  1.  ... NEW PASS,COND
  1.  ... ;
  1.  ... ;Get the condition and execute
  1.  ... S PASS=0,COND=CDARY(MGRP,CNTR,CNDCT) X COND
  1.  ... S:'PASS FAIL=1
  1.  .. ;
  1.  .. ;Quit priority if any check failed
  1.  .. I FAIL Q
  1.  .. ;
  1.  .. ;Quit if COD is inactive
  1.  .. I '$$VRSN^BSTSVICD(COD,VDT) Q
  1.  .. ;
  1.  .. ;Add code to the list and mark that one was found for the group
  1.  .. S ICD=$G(ICD)_$S(ICD]"":";",1:"")_COD
  1.  .. S GFND=1
  1.  ;
  1.  Q ICD
  1.  ;
  1. BCOND(CONC,CDARY) ;Build the condition array
  1.  ;
  1.  ;Returns a list of conditions for an array and the CODE for each
  1.  ;CDARY(MGRP,CNTR)=ICD10 code
  1.  ;CDARY(MGRP,CNTR,#)=Executable M code for the condition
  1.  ;                   Condition will return PASS=0 (Fail) or PASS=1 (Success) if all conditions pass
  1.  ;                   then the ICD10 for that priority/counter will be assigned for that map group
  1.  ;
  1.  ;Where:
  1.  ;MGRP - The map group
  1.  ;CNTR - The priority/counter within the group
  1.  ;# - The condition entry or entries for that priority/counter
  1.  ;
  1.  NEW CIEN,MGRP
  1.  ;
  1.  ;Get the internal CIEN
  1.  S CIEN=$O(^BSTS(9002318.4,"C",36,CONC,"")) Q:CIEN=""
  1.  ;
  1.  ;Loop through each map group
  1.  S MGRP=0 F  S MGRP=$O(^BSTS(9002318.4,CIEN,14,"C",MGRP)) Q:'MGRP  D
  1.  . ;
  1.  . NEW MPRI
  1.  . ;
  1.  . ;Loop through by priority
  1.  . S MPRI="" F  S MPRI=$O(^BSTS(9002318.4,CIEN,14,"C",MGRP,MPRI)) Q:MPRI=""  D
  1.  .. ;
  1.  .. NEW CNTR
  1.  .. ;
  1.  .. ;Loop through by counter - counter needed because priority may not be unique
  1.  .. S CNTR="" F  S CNTR=$O(^BSTS(9002318.4,CIEN,14,"C",MGRP,MPRI,CNTR)) Q:CNTR=""  D
  1.  ... ;
  1.  ... NEW CIEN1
  1.  ... ;
  1.  ... ;Loop through by CIEN1 (IEN of the ICD CONDITIONAL MAPPING multiple)
  1.  ... S CIEN1="" F  S CIEN1=$O(^BSTS(9002318.4,CIEN,14,"C",MGRP,MPRI,CNTR,CIEN1)) Q:CIEN1=""  D
  1.  .... ;
  1.  .... ;Capture the ICD10 code assigned to that priority/counter
  1.  .... NEW CIEN2,COD,DA,IENS
  1.  .... S DA(1)=CIEN,DA=CIEN1,IENS=$$IENS^DILF(.DA)
  1.  .... S COD=$$GET1^DIQ(9002318.414,IENS,".04","E") Q:COD=""  ;Code
  1.  .... S CDARY(MGRP,CNTR)=COD
  1.  .... ;
  1.  .... ;Loop through by Condition (priority/counters could have >1 condition - AND logic applies)
  1.  .... S CIEN2=0 F  S CIEN2=$O(^BSTS(9002318.4,CIEN,14,CIEN1,1,CIEN2)) Q:'CIEN2  D
  1.  ..... ;
  1.  ..... NEW VAR,OP,VAL,DA,IENS,COND
  1.  ..... ;
  1.  ..... ;Parse the condition
  1.  ..... S DA(2)=CIEN,DA(1)=CIEN1,DA=CIEN2,IENS=$$IENS^DILF(.DA)
  1.  ..... S VAR=$$GET1^DIQ(9002318.4141,IENS,".01","E") ;Variable
  1.  ..... S OP=$$GET1^DIQ(9002318.4141,IENS,".02","E") ;Condition
  1.  ..... S VAL=$$GET1^DIQ(9002318.4141,IENS,".03","E") ;Value
  1.  ..... S:VAL]"" VAL=$C(34)_VAL_$C(34) ;Add quotes to value
  1.  ..... ;
  1.  ..... ;Assemble the condition
  1.  ..... ;Need special logic to handle if the patient value is null (so if check is AAO<29 and no visit
  1.  ..... ;passed in AAO value would be null. In this case do not pass the check (even though ""<29). If
  1.  ..... ;the condition is looking for a null though (Ex. AC="") allow it.
  1.  ..... S COND="S PASS=0 I ("_VAR_"]"""")!("_VAR_"=""""&("_VAL_"="""")),"_VAR_OP_VAL_" S PASS=1"
  1.  ..... ;
  1.  ..... ;Set up the array
  1.  ..... S CDARY(MGRP,CNTR,CIEN2)=COND
  1.  ;
  1.  Q
  1.  ;
  1. HLCHC(LST) ;Return list of healing choices for a concept
  1.  ;
  1.  NEW CHOICE,TERM
  1.  ;
  1.  S (TERM,CHOICE)=""  F  S TERM=$O(^BSTS(9002318.6,"D","HEAL",TERM)) Q:TERM=""  D
  1.  . NEW SNOMED
  1.  . S SNOMED=$O(^BSTS(9002318.6,"D","HEAL",TERM,"")) Q:SNOMED=""
  1.  . I TERM="NL Union",LST["R" S CHOICE=CHOICE_$S(CHOICE]"":";",1:"")_TERM_"|"_SNOMED
  1.  . I TERM="Delayed",LST["D" S CHOICE=CHOICE_$S(CHOICE]"":";",1:"")_TERM_"|"_SNOMED
  1.  . I TERM="Malunion",LST["M" S CHOICE=CHOICE_$S(CHOICE]"":";",1:"")_TERM_"|"_SNOMED
  1.  . I TERM="Nonunion",LST["N" S CHOICE=CHOICE_$S(CHOICE]"":";",1:"")_TERM_"|"_SNOMED
  1.  ;
  1.  Q CHOICE