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

ONCOTM.m

Go to the documentation of this file.
  1. ONCOTM ;HINES IRMFO/WAA-ONCO TUMOR MARKER PROMPT 1/7/98 10:33
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. TM(IEN,TUM) ;
  1. ; This routine will set the prompt base on the primary site
  1. ; X is the internal entry number of the entry in file 165.5
  1. ; TUM is which tumor marker this is.
  1. N %,D,DC,DIC,DIE,DIEL,DIFLD,DIP,DK,DM,DOV,DQ,DU,DV,DW,DXS
  1. N DH,DIR,DA,D0,D1,DIE,DR,DP,DO,DL,I,ICDO,X,TM1,TM2,TM,U
  1. K Y
  1. S DIE="^ONCO(165.5,",DA=IEN
  1. I TUM=1 S DR="25.1"_$$PROMPT(IEN,TUM)
  1. I TUM=2 S DR="25.2"_$$PROMPT(IEN,TUM)
  1. I TUM=3 S DR="25.3"_$$PROMPT(IEN,TUM)
  1. D ^DIE
  1. I $D(Y) S Y="@0" Q
  1. I TUM=1 S Y="@2510"
  1. I TUM=2 S Y="@2520"
  1. I TUM=3 S Y="@2530"
  1. Q
  1. PRINT(IEN,TUM) ;
  1. ; This routine will set the prompt base on the primary site
  1. ; IEN is the internal entry number of the entry in file 165.5
  1. ; TUM is which tumor marker this is.
  1. N PROMPT,LOWER,CAP,I,WORD
  1. S PROMPT=$$PROMPT(IEN,TUM)
  1. S LOWER=$$LOW^XLFSTR(PROMPT)
  1. F I=1:1 S WORD=$P(LOWER," ",I) Q:WORD="" D
  1. .I $E(WORD,1)="(" S $P(LOWER," ",I)=$P(PROMPT," ",I) Q
  1. .N NEW,OLD,NWORD
  1. .S OLD=$E(WORD,1)
  1. .S NEW=$$UP^XLFSTR(OLD)
  1. .S NWORD=NEW_$E(WORD,2,99999)
  1. .S $P(LOWER," ",I)=NWORD
  1. .Q
  1. S PROMPT=LOWER
  1. Q PROMPT
  1. PROMPT(IEN,TUM) ;
  1. ; This routine will set the prompt base on the primary site
  1. ; IEN is the internal entry number of the entry in file 165.5
  1. ; TUM is which tumor marker this is.
  1. N PROMPT
  1. S PROMPT=$S(TUM=1:"TUMOR MARKER 1",TUM=2:"TUMOR MARKER 2",TUM=3:"TUMOR MARKER 3",1:"TUMOR MARKER")
  1. I TUM=1 D TUMOR(TUM,"17-63")
  1. I TUM=2 D TUMOR(TUM,"49-63")
  1. I TUM=3 D TUMOR(TUM,"61-63")
  1. Q PROMPT
  1. ;
  1. TUMOR(TUM,RANGE) ; Execute if valid tumor marker
  1. N PRIM1
  1. S PRIM1=$$GET1^DIQ(165.5,IEN,20,"I")
  1. I PRIM1'="" D
  1. .N PRIM2
  1. .S PRIM2=$$GET1^DIQ(164,PRIM1,1,"I")
  1. .I PRIM2'="" D
  1. ..N PRIM3,LINE,LOOP,NUMBER,FLG,X
  1. ..S PRIM3=$P(PRIM2,"C",2)
  1. ..I PRIM3'>$P(RANGE,"-")!(PRIM3'<$P(RANGE,"-",2)) Q
  1. ..S FLG=0
  1. ..S X="S LINE=$T(TABLE"_TUM_"+LOOP)"
  1. ..F LOOP=1:1 X X Q:$P(LINE,";",3)="" D Q:FLG
  1. ...S LINE=$P(LINE,";",3),NUMBER=$P(LINE,U)
  1. ...I NUMBER["-" D Q
  1. ....N NUM1,NUM2
  1. ....S NUM1=$P(NUMBER,"-"),NUM2=$P(NUMBER,"-",2)
  1. ....I PRIM3<NUM1 Q
  1. ....I PRIM3>NUM2 Q
  1. ....S FLG=1,PROMPT=$P(LINE,U,2)
  1. ....Q
  1. ...I PRIM3=NUMBER S FLG=1,PROMPT=$P(LINE,U,2)
  1. ...Q
  1. ..Q
  1. .Q
  1. I TUM=1,PROMPT="TUMOR MARKER 1",$$HIST^ONCFUNC(IEN)=95003 S PROMPT="TUMOR MARKER 1 (UC)"
  1. Q
  1. ;
  1. TABLE1 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
  1. ;;18.0-18.9^TUMOR MARKER 1 (CEA)
  1. ;;19.9^TUMOR MARKER 1 (CEA)
  1. ;;20.9^TUMOR MARKER 1 (CEA)
  1. ;;22.0^TUMOR MARKER 1 (AFP)
  1. ;;22.1^TUMOR MARKER 1 (AFP)
  1. ;;50.0-50.9^TUMOR MARKER 1 (ERA)
  1. ;;56.9^TUMOR MARKER 1 (CA-125)
  1. ;;61.9^TUMOR MARKER 1 (PAP)
  1. ;;62.0^TUMOR MARKER 1 (AFP)
  1. ;;62.1^TUMOR MARKER 1 (AFP)
  1. ;;62.9^TUMOR MARKER 1 (AFP)
  1. ;;
  1. TABLE2 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
  1. ;;50.0-50.9^TUMOR MARKER 2 (PRA)
  1. ;;61.9^TUMOR MARKER 2 (PSA)
  1. ;;62.0^TUMOR MARKER 2 (hCG)
  1. ;;62.1^TUMOR MARKER 2 (hCG)
  1. ;;62.9^TUMOR MARKER 2 (hCG)
  1. ;;
  1. TABLE3 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
  1. ;;62.0^TUMOR MARKER 3 (LDH)
  1. ;;62.1^TUMOR MARKER 3 (LDH)
  1. ;;62.9^TUMOR MARKER 3 (LDH)
  1. ;;
  1. SCREEN ;;Tumor Marker screen
  1. I $$TNMED^ONCOU55(D0)<5,Y<7 Q
  1. I $$TNMED^ONCOU55(D0)>4,(($E($P($G(^ONCO(165.5,DA,2)),U,1),3,4)=62)&(Y<2!(Y>4)))!(($E($P($G(^ONCO(165.5,DA,2)),U,1),3,4)'=62)&(Y<7)) Q