ONCOTM ;HINES IRMFO/WAA-ONCO TUMOR MARKER PROMPT 1/7/98 10:33
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
TM(IEN,TUM) ;
; This routine will set the prompt base on the primary site
; X is the internal entry number of the entry in file 165.5
; TUM is which tumor marker this is.
N %,D,DC,DIC,DIE,DIEL,DIFLD,DIP,DK,DM,DOV,DQ,DU,DV,DW,DXS
N DH,DIR,DA,D0,D1,DIE,DR,DP,DO,DL,I,ICDO,X,TM1,TM2,TM,U
K Y
S DIE="^ONCO(165.5,",DA=IEN
I TUM=1 S DR="25.1"_$$PROMPT(IEN,TUM)
I TUM=2 S DR="25.2"_$$PROMPT(IEN,TUM)
I TUM=3 S DR="25.3"_$$PROMPT(IEN,TUM)
D ^DIE
I $D(Y) S Y="@0" Q
I TUM=1 S Y="@2510"
I TUM=2 S Y="@2520"
I TUM=3 S Y="@2530"
Q
PRINT(IEN,TUM) ;
; This routine will set the prompt base on the primary site
; IEN is the internal entry number of the entry in file 165.5
; TUM is which tumor marker this is.
N PROMPT,LOWER,CAP,I,WORD
S PROMPT=$$PROMPT(IEN,TUM)
S LOWER=$$LOW^XLFSTR(PROMPT)
F I=1:1 S WORD=$P(LOWER," ",I) Q:WORD="" D
.I $E(WORD,1)="(" S $P(LOWER," ",I)=$P(PROMPT," ",I) Q
.N NEW,OLD,NWORD
.S OLD=$E(WORD,1)
.S NEW=$$UP^XLFSTR(OLD)
.S NWORD=NEW_$E(WORD,2,99999)
.S $P(LOWER," ",I)=NWORD
.Q
S PROMPT=LOWER
Q PROMPT
PROMPT(IEN,TUM) ;
; This routine will set the prompt base on the primary site
; IEN is the internal entry number of the entry in file 165.5
; TUM is which tumor marker this is.
N PROMPT
S PROMPT=$S(TUM=1:"TUMOR MARKER 1",TUM=2:"TUMOR MARKER 2",TUM=3:"TUMOR MARKER 3",1:"TUMOR MARKER")
I TUM=1 D TUMOR(TUM,"17-63")
I TUM=2 D TUMOR(TUM,"49-63")
I TUM=3 D TUMOR(TUM,"61-63")
Q PROMPT
;
TUMOR(TUM,RANGE) ; Execute if valid tumor marker
N PRIM1
S PRIM1=$$GET1^DIQ(165.5,IEN,20,"I")
I PRIM1'="" D
.N PRIM2
.S PRIM2=$$GET1^DIQ(164,PRIM1,1,"I")
.I PRIM2'="" D
..N PRIM3,LINE,LOOP,NUMBER,FLG,X
..S PRIM3=$P(PRIM2,"C",2)
..I PRIM3'>$P(RANGE,"-")!(PRIM3'<$P(RANGE,"-",2)) Q
..S FLG=0
..S X="S LINE=$T(TABLE"_TUM_"+LOOP)"
..F LOOP=1:1 X X Q:$P(LINE,";",3)="" D Q:FLG
...S LINE=$P(LINE,";",3),NUMBER=$P(LINE,U)
...I NUMBER["-" D Q
....N NUM1,NUM2
....S NUM1=$P(NUMBER,"-"),NUM2=$P(NUMBER,"-",2)
....I PRIM3<NUM1 Q
....I PRIM3>NUM2 Q
....S FLG=1,PROMPT=$P(LINE,U,2)
....Q
...I PRIM3=NUMBER S FLG=1,PROMPT=$P(LINE,U,2)
...Q
..Q
.Q
I TUM=1,PROMPT="TUMOR MARKER 1",$$HIST^ONCFUNC(IEN)=95003 S PROMPT="TUMOR MARKER 1 (UC)"
Q
;
TABLE1 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
;;18.0-18.9^TUMOR MARKER 1 (CEA)
;;19.9^TUMOR MARKER 1 (CEA)
;;20.9^TUMOR MARKER 1 (CEA)
;;22.0^TUMOR MARKER 1 (AFP)
;;22.1^TUMOR MARKER 1 (AFP)
;;50.0-50.9^TUMOR MARKER 1 (ERA)
;;56.9^TUMOR MARKER 1 (CA-125)
;;61.9^TUMOR MARKER 1 (PAP)
;;62.0^TUMOR MARKER 1 (AFP)
;;62.1^TUMOR MARKER 1 (AFP)
;;62.9^TUMOR MARKER 1 (AFP)
;;
TABLE2 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
;;50.0-50.9^TUMOR MARKER 2 (PRA)
;;61.9^TUMOR MARKER 2 (PSA)
;;62.0^TUMOR MARKER 2 (hCG)
;;62.1^TUMOR MARKER 2 (hCG)
;;62.9^TUMOR MARKER 2 (hCG)
;;
TABLE3 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
;;62.0^TUMOR MARKER 3 (LDH)
;;62.1^TUMOR MARKER 3 (LDH)
;;62.9^TUMOR MARKER 3 (LDH)
;;
SCREEN ;;Tumor Marker screen
I $$TNMED^ONCOU55(D0)<5,Y<7 Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTM 3311 printed Apr 09, 2024@21:31:06 Page 2
ONCOTM ;HINES IRMFO/WAA-ONCO TUMOR MARKER PROMPT 1/7/98 10:33
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
TM(IEN,TUM) ;
+1 ; This routine will set the prompt base on the primary site
+2 ; X is the internal entry number of the entry in file 165.5
+3 ; TUM is which tumor marker this is.
+4 NEW %,D,DC,DIC,DIE,DIEL,DIFLD,DIP,DK,DM,DOV,DQ,DU,DV,DW,DXS
+5 NEW DH,DIR,DA,D0,D1,DIE,DR,DP,DO,DL,I,ICDO,X,TM1,TM2,TM,U
+6 KILL Y
+7 SET DIE="^ONCO(165.5,"
SET DA=IEN
+8 IF TUM=1
SET DR="25.1"_$$PROMPT(IEN,TUM)
+9 IF TUM=2
SET DR="25.2"_$$PROMPT(IEN,TUM)
+10 IF TUM=3
SET DR="25.3"_$$PROMPT(IEN,TUM)
+11 DO ^DIE
+12 IF $DATA(Y)
SET Y="@0"
QUIT
+13 IF TUM=1
SET Y="@2510"
+14 IF TUM=2
SET Y="@2520"
+15 IF TUM=3
SET Y="@2530"
+16 QUIT
PRINT(IEN,TUM) ;
+1 ; This routine will set the prompt base on the primary site
+2 ; IEN is the internal entry number of the entry in file 165.5
+3 ; TUM is which tumor marker this is.
+4 NEW PROMPT,LOWER,CAP,I,WORD
+5 SET PROMPT=$$PROMPT(IEN,TUM)
+6 SET LOWER=$$LOW^XLFSTR(PROMPT)
+7 FOR I=1:1
SET WORD=$PIECE(LOWER," ",I)
if WORD=""
QUIT
Begin DoDot:1
+8 IF $EXTRACT(WORD,1)="("
SET $PIECE(LOWER," ",I)=$PIECE(PROMPT," ",I)
QUIT
+9 NEW NEW,OLD,NWORD
+10 SET OLD=$EXTRACT(WORD,1)
+11 SET NEW=$$UP^XLFSTR(OLD)
+12 SET NWORD=NEW_$EXTRACT(WORD,2,99999)
+13 SET $PIECE(LOWER," ",I)=NWORD
+14 QUIT
End DoDot:1
+15 SET PROMPT=LOWER
+16 QUIT PROMPT
PROMPT(IEN,TUM) ;
+1 ; This routine will set the prompt base on the primary site
+2 ; IEN is the internal entry number of the entry in file 165.5
+3 ; TUM is which tumor marker this is.
+4 NEW PROMPT
+5 SET PROMPT=$SELECT(TUM=1:"TUMOR MARKER 1",TUM=2:"TUMOR MARKER 2",TUM=3:"TUMOR MARKER 3",1:"TUMOR MARKER")
+6 IF TUM=1
DO TUMOR(TUM,"17-63")
+7 IF TUM=2
DO TUMOR(TUM,"49-63")
+8 IF TUM=3
DO TUMOR(TUM,"61-63")
+9 QUIT PROMPT
+10 ;
TUMOR(TUM,RANGE) ; Execute if valid tumor marker
+1 NEW PRIM1
+2 SET PRIM1=$$GET1^DIQ(165.5,IEN,20,"I")
+3 IF PRIM1'=""
Begin DoDot:1
+4 NEW PRIM2
+5 SET PRIM2=$$GET1^DIQ(164,PRIM1,1,"I")
+6 IF PRIM2'=""
Begin DoDot:2
+7 NEW PRIM3,LINE,LOOP,NUMBER,FLG,X
+8 SET PRIM3=$PIECE(PRIM2,"C",2)
+9 IF PRIM3'>$PIECE(RANGE,"-")!(PRIM3'<$PIECE(RANGE,"-",2))
QUIT
+10 SET FLG=0
+11 SET X="S LINE=$T(TABLE"_TUM_"+LOOP)"
+12 FOR LOOP=1:1
XECUTE X
if $PIECE(LINE,";",3)=""
QUIT
Begin DoDot:3
+13 SET LINE=$PIECE(LINE,";",3)
SET NUMBER=$PIECE(LINE,U)
+14 IF NUMBER["-"
Begin DoDot:4
+15 NEW NUM1,NUM2
+16 SET NUM1=$PIECE(NUMBER,"-")
SET NUM2=$PIECE(NUMBER,"-",2)
+17 IF PRIM3<NUM1
QUIT
+18 IF PRIM3>NUM2
QUIT
+19 SET FLG=1
SET PROMPT=$PIECE(LINE,U,2)
+20 QUIT
End DoDot:4
QUIT
+21 IF PRIM3=NUMBER
SET FLG=1
SET PROMPT=$PIECE(LINE,U,2)
+22 QUIT
End DoDot:3
if FLG
QUIT
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 IF TUM=1
IF PROMPT="TUMOR MARKER 1"
IF $$HIST^ONCFUNC(IEN)=95003
SET PROMPT="TUMOR MARKER 1 (UC)"
+26 QUIT
+27 ;
TABLE1 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
+1 ;;18.0-18.9^TUMOR MARKER 1 (CEA)
+2 ;;19.9^TUMOR MARKER 1 (CEA)
+3 ;;20.9^TUMOR MARKER 1 (CEA)
+4 ;;22.0^TUMOR MARKER 1 (AFP)
+5 ;;22.1^TUMOR MARKER 1 (AFP)
+6 ;;50.0-50.9^TUMOR MARKER 1 (ERA)
+7 ;;56.9^TUMOR MARKER 1 (CA-125)
+8 ;;61.9^TUMOR MARKER 1 (PAP)
+9 ;;62.0^TUMOR MARKER 1 (AFP)
+10 ;;62.1^TUMOR MARKER 1 (AFP)
+11 ;;62.9^TUMOR MARKER 1 (AFP)
+12 ;;
TABLE2 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
+1 ;;50.0-50.9^TUMOR MARKER 2 (PRA)
+2 ;;61.9^TUMOR MARKER 2 (PSA)
+3 ;;62.0^TUMOR MARKER 2 (hCG)
+4 ;;62.1^TUMOR MARKER 2 (hCG)
+5 ;;62.9^TUMOR MARKER 2 (hCG)
+6 ;;
TABLE3 ;;NUMBER/NUMBER-RANGE^NEW PROMPT
+1 ;;62.0^TUMOR MARKER 3 (LDH)
+2 ;;62.1^TUMOR MARKER 3 (LDH)
+3 ;;62.9^TUMOR MARKER 3 (LDH)
+4 ;;
SCREEN ;;Tumor Marker screen
+1 IF $$TNMED^ONCOU55(D0)<5
IF Y<7
QUIT
+2 IF $$TNMED^ONCOU55(D0)>4
IF (($EXTRACT($PIECE($GET(^ONCO(165.5,DA,2)),U,1),3,4)=62)&(Y<2!(Y>4)))!(($EXTRACT($PIECE($GET(^ONCO(165.5,DA,2)),U,1),3,4)'=62)&(Y<7))
QUIT
