- 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 Jan 18, 2025@03:27:03 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