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

ONCOMNI.m

Go to the documentation of this file.
  1. ONCOMNI ;Hines OIFO/GWB - MISCELLANEOUS ;12/10/99
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. ;D SETUP^ONCOES
  1. ;S NAME=$P(@ONCOX1,U,1),FNMI=$P(NAME,",",2),MNI=$P(FNMI," ",2)
  1. ;I (MNI="JR")!(MNI="JR.")!(MNI="SR")!(MNI="SR.")!(MNI="MD")!(MNI="MD.")!(MNI="NMN")!(MNI="NMN.")!(MNI="NMI")!(MNI="NMI.")!(MNI="II")!(MNI="III")!(MNI="IV") S MNI=""
  1. ;I $L(MNI)=2,$E(MNI,2)="." S MNI=$E(MNI,1)
  1. ;S X=$E(MNI,1,14)
  1. ;K ONCON,ONCOX,ONCOX1,NAME,FNMI,MNI
  1. Q
  1. CHFPS ;CALCULATE VALUE OF FIELD #803 (CANCER HISTORY-1ST PRIMARY SITE)
  1. I $P($G(^ONCO(165.5,D0,"NHL1")),U,4)'="" S X="" Q
  1. S CHFSNM=$P($G(^ONCO(165.5,D0,0)),U,2)
  1. S X="C88.8",CHFSFLG=0
  1. S CHFS="" F S CHFS=$O(^ONCO(165.5,"C",CHFSNM,CHFS)) Q:CHFS'>""!(CHFSFLG>0) I $$DIV^ONCFUNC(CHFS)=DUZ(2) D
  1. .I CHFS=D0 Q
  1. .S CHFSFLG=CHFSFLG+1,TPX=$P($G(^ONCO(165.5,CHFS,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K CHFS,CHFSFLG,CHFSNM,TPX Q
  1. CHFPH ;CALCULATE VALUE OF FIELD #804 (CANCER HISTORY-1ST PRIMARY HISTOLOGY)
  1. I $P($G(^ONCO(165.5,D0,"NHL1")),U,5)'="" S X="" Q
  1. S CHFHNM=$P($G(^ONCO(165.5,D0,0)),U,2)
  1. S X="8888/8",CHFHFLG=0
  1. S CHFH="" F S CHFH=$O(^ONCO(165.5,"C",CHFHNM,CHFH)) Q:CHFH'>""!(CHFHFLG>0) I $$DIV^ONCFUNC(CHFH)=DUZ(2) D
  1. .I CHFH=D0 Q
  1. .S CHFHFLG=CHFHFLG+1,TPX=$$HIST^ONCFUNC(CHFH,.HSTFLD,.HISTNAM,.ICDFILE) S:TPX'="" TPX=$G(^ONCO(ICDFILE,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K CHFH,CHFHFLG,CHFHNM,HISTNAM,HSTFLD,ICDFILE,TPX Q
  1. ;
  1. CHSPS ;CALCULATE VALUE OF FIELD #805 (CANCER HISTORY-2ND PRIMARY SITE)
  1. I $P($G(^ONCO(165.5,D0,"NHL1")),U,6)'="" S X="" Q
  1. S CHSSNM=$P($G(^ONCO(165.5,D0,0)),U,2)
  1. S X="C88.8",CHSSFLG=0
  1. S CHSS="" F S CHSS=$O(^ONCO(165.5,"C",CHSSNM,CHSS)) Q:CHSS'>""!(CHSSFLG>1) I $$DIV^ONCFUNC(CHSS)=DUZ(2) D
  1. .I CHSS=D0 Q
  1. .I CHSSFLG=0 S CHSSFLG=CHSSFLG+1 Q
  1. .S CHSSFLG=CHSSFLG+1,TPX=$P($G(^ONCO(165.5,CHSS,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K CHSS,CHSSFLG,CHSSNM,TPX Q
  1. CHSPH ;CALCULATE VALUE OF FIELD #806 (CANCER HISTORY-2ND PRIMARY HISTOLOGY)
  1. I $P($G(^ONCO(165.5,D0,"NHL1")),U,7)'="" S X="" Q
  1. S CHSHNM=$P($G(^ONCO(165.5,D0,0)),U,2)
  1. S X="8888/8",CHSHFLG=0
  1. S CHSH="" F S CHSH=$O(^ONCO(165.5,"C",CHSHNM,CHSH)) Q:CHSH'>""!(CHSHFLG>1) I $$DIV^ONCFUNC(CHSH)=DUZ(2) D
  1. .I CHSH=D0 Q
  1. .I CHSHFLG=0 S CHSHFLG=CHSHFLG+1 Q
  1. .S CHSHFLG=CHSHFLG+1,TPX=$$HIST^ONCFUNC(CHSH,.HSTFLD,.HISTNAM,.ICDFILE) S:TPX'="" TPX=$G(^ONCO(ICDFILE,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K CHSH,CHSHFLG,CHSHNM,TPX Q
  1. ARCHHLP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) HELP
  1. W !?5,"Choose from the following codes:",!
  1. W !?8,"0 Not HIV positive"
  1. W !?8,"1 No known risk category"
  1. W !?8,"2 Homosexual/Bisexual"
  1. W !?8,"3 IV drug user"
  1. W !?8,"4 Blood product recipient"
  1. W !?8,"5 Heterosexual transmission"
  1. W !?8,"6 Congenitally acquired"
  1. W !?8,"7 Multiple categories"
  1. W !?8,"8 Other/Unknown risk category"
  1. W !?8,"9 Unknown if HIV positive",!
  1. Q
  1. ARCHP ;AIDS RISK CATEGORY FOR HIV POSITIVE PATIENT (#822) OUTPUT TRANSFORM
  1. I Y=0 S Y="Not HIV positive" Q
  1. I Y=1 S Y="No known risk category" Q
  1. I Y=2 S Y="Homosexual/Bisexual" Q
  1. I Y=3 S Y="IV drug user" Q
  1. I Y=4 S Y="Blood product recipient" Q
  1. I Y=5 S Y="Heterosexual transmission" Q
  1. I Y=6 S Y="Congenitally acquired" Q
  1. I Y=7 S Y="Multiple categories" Q
  1. I Y=8 S Y="Other/Unknown risk category" Q
  1. I Y=9 S Y="Unknown if HIV positive" Q
  1. Q
  1. EXNSIT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) INPUT TRANSFORM
  1. N CCD
  1. I X[U!(X="") K X Q
  1. I $L(X)<3 W *7," Must be at least 3 characters " K X Q
  1. I X=888!(X="C888")!(X=88.8)!(X="C88.8") S X="C888" W " None" Q
  1. I X=999!(X="C999")!(X=99.9)!(X="C99.9") S X="C999" W " Unknown" Q
  1. K DIC S DIC="^ONCO(164,",DIC(0)="EMQ" D ^DIC
  1. I Y<0 K X Q
  1. I +Y'<0 S CCD=$P($G(^ONCO(164,+Y,0)),U,2) S X=$E(CCD,1,3)_$E(CCD,5) Q
  1. EXNSOT ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) OUTPUT TRANSFORM
  1. I Y="C888" S Y="None" Q
  1. I Y="C999" S Y="Unknown" Q
  1. S EXN=$E(Y,1,3)_"."_$E(Y,4)
  1. F TPG=0:0 S TPG=$O(^ONCO(164,TPG)) Q:TPG'>0 D
  1. .I EXN'=$P($G(^ONCO(164,TPG,0)),U,2) Q
  1. .S TPGNM=$P($G(^ONCO(164,TPG,0)),U,1),EXN=EXN_" "_TPGNM Q
  1. S Y=EXN K EXN,TPG,TPGNM Q
  1. XHP ;EXTRANODAL SITE 1,2,3 (FIELDS #852,#853,#854) EXECUTABLE HELP
  1. I X'="?",X'="??" Q
  1. K DIC S DIC="^ONCO(164,",DIC(0)="EMQ" D ^DIC Q
  1. RCSIT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) INPUT TRANSFORM
  1. I X=0!(X=5)!(X=6) K X Q
  1. S Y=X D RCSOT W " ",Y K Y
  1. Q
  1. RCSOT ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) OUTPUT TRANSFORM
  1. I Y=1 S Y="Radiation before chemotherapy"
  1. I Y=2 S Y="Chemotherapy before radiation"
  1. I Y=3 S Y="Chemotherapy before and after radiation"
  1. I Y=4 S Y="Radiation and chemotherapy concurrently"
  1. I Y=7 S Y="Unknown if radiation and/or chemo given"
  1. I Y=8 S Y="NA, no radiation and/or no chemo given"
  1. I Y=9 S Y="Sequence unknown"
  1. Q
  1. RCSHP ;RADIATION/CHEMOTHERAPY SEQUENCE (#862) HELP
  1. N DTDX,FSDX
  1. W !," 1 Radiation before chemotherapy"
  1. W !," 2 Chemotherapy before radiation"
  1. W !," 3 Chemotherapy before and after radiation"
  1. W !," 4 Radiation and chemotherapy concurrently"
  1. W !," 7 Unknown if radiation and/or chemo given"
  1. W !," 8 NA, no radiation and/or no chemo given"
  1. W !," 9 Sequence unknown",!
  1. Q
  1. S %DT="EP",%DT(0)="-NOW" D ^%DT S X=Y K:Y<1 X K %DT
  1. I $D(X) S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16) I DTDX'="" K:X<DTDX X
  1. FSC ;Calculate default for fields #1102,#1103
  1. ;I $P($G(^ONCO(165.5,D0,"MEL1")),U,3)'="" S X="" Q
  1. S PNM=$P($G(^ONCO(165.5,D0,0)),U,2),X="C88.8",FSDX="88/8888"
  1. S ST=0 F S ST=$O(^ONCO(165.5,"C",PNM,ST)) Q:ST'>0 I $$DIV^ONCFUNC(ST)=DUZ(2) S LAST=ST
  1. I LAST'=D0 D
  1. .S Y=$P($G(^ONCO(165.5,LAST,0)),U,16) D CHDTOT^ONCOPCE S FSDX=Y
  1. .S TPX=$P($G(^ONCO(165.5,LAST,2)),U,1) I TPX="" Q
  1. .S TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. I LAST=D0 F S LAST=$O(^ONCO(165.5,"C",PNM,LAST),-1) Q:LAST="" I $$DIV^ONCFUNC(LAST)=DUZ(2) D Q
  1. .S Y=$P($G(^ONCO(165.5,LAST,0)),U,16) D CHDTOT^ONCOPCE S FSDX=Y
  1. .S TPX=$P($G(^ONCO(165.5,LAST,2)),U,1) I TPX="" Q
  1. .S TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K LAST,PNM,ST,TPX Q
  1. SSC ;Calculate default for fields #1104,#1105
  1. S PNM=$P($G(^ONCO(165.5,D0,0)),U,2),X="C88.8",SSDX="88/8888",FLG=0
  1. S ST=0 F S ST=$O(^ONCO(165.5,"C",PNM,ST)) Q:ST'>0 I $$DIV^ONCFUNC(ST)=DUZ(2) S LAST=ST
  1. I LAST'=D0 S FLG=FLG+1
  1. S SSC=LAST F S SSC=$O(^ONCO(165.5,"C",PNM,SSC),-1) Q:SSC'>""!(FLG>1) I $$DIV^ONCFUNC(SSC)=DUZ(2) D
  1. .I SSC=D0 Q
  1. .I FLG=0 S FLG=FLG+1 Q
  1. .S FLG=FLG+1
  1. .S Y=$P($G(^ONCO(165.5,SSC,0)),U,16) D CHDTOT^ONCOPCE S SSDX=Y
  1. .S TPX=$P($G(^ONCO(165.5,SSC,2)),U,1) S:TPX'="" TPX=$G(^ONCO(164,TPX,0)) S:TPX'="" X=$P(TPX,U,2) Q
  1. K FLG,LAST,PNM,SSC,SSDX,ST,TPX Q
  1. ;
  1. NSNIT ;Number of Satellite Nodules (#1112)
  1. I X'?1.2N K X Q
  1. I X=0!(X="00") S X="00" W " No satellite nodules"
  1. I X=96 W " 96 or more nodules"
  1. I X=97 W " Satellite nodules, # unknown"
  1. I X=98 W " NA, non-cutaneous melanoma"
  1. I X=99 W " Unknown"
  1. S X=$S($L(X)=1:"0"_X,1:X)
  1. Q
  1. NSNOT ;Number of Satellite Nodules (#1112)
  1. I Y="00" S Y="No satellite nodules" Q
  1. I Y=96 S Y="96 or more nodules" Q
  1. I Y=97 S Y="Satellite nodules, # unknown" Q
  1. I Y=98 S Y="NA, non-cutaneous melanoma" Q
  1. I Y=99 S Y="Unknown" Q
  1. S Y=$S(Y="01":Y_" nodule",1:Y_" nodules")
  1. Q
  1. BTIT ;Breslow's Thickness (#1113)
  1. I X'?1.3N K X Q
  1. I X=997 W " Cutaneous melanoma, thickness unk"
  1. I X=998 W " NA, non-cutaneous melanoma"
  1. I X=999 W " Primary site unknown"
  1. S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X)
  1. Q
  1. BTOT ;Breslow's Thickness (#1113)
  1. I Y=997 S Y="Cutaneous melanoma, thickness unk" Q
  1. I Y=998 S Y="NA, non-cutaneous melanoma" Q
  1. I Y=999 S Y="Primary site unknown" Q
  1. S Y=Y_" mm"
  1. Q
  1. MDIT ;Margin Distance (#1120)
  1. I X'?1.3N K X Q
  1. I X=997 W " Margins free, distance unknown"
  1. I X=998 W " NA, surgery not performed"
  1. I X=999 W " Unknown"
  1. S X=$S($L(X)=1:"00"_X,$L(X)=2:"0"_X,1:X)
  1. Q
  1. MDOT ;Margin Distance (#1120)
  1. I Y=996 S Y=Y_"mm or more" Q
  1. I Y=997 S Y="Margins free, distance unknown" Q
  1. I Y=998 S Y="NA, surgery not performed" Q
  1. I Y=999 S Y="Unknown" Q
  1. S Y=Y_"mm"
  1. Q
  1. ;
  1. SNPIT ;Sentinel Nodes Positive (#1125)
  1. N SNE
  1. I X=0!(X>6) Q
  1. S SNE=$P($G(^ONCO(165.5,D0,"MEL1")),U,25) I SNE=""!(SNE>5) Q
  1. I X>SNE W !," Sentinel Nodes Positive MUST be less than/equal Sentinel Nodes Examined! " K X Q
  1. Q
  1. ;
  1. NBPIT ;Number of Basins Positive (#1129)
  1. N NBD
  1. I X=0!(X>6) Q
  1. S NBD=$P($G(^ONCO(165.5,D0,"MEL1")),U,29) I NBD=""!(NBD>5) Q
  1. I X>NBD W !," Number of Basins Positive MUST be less than/equal to Basins Detected! " K X Q
  1. Q