ONCOES ;Hines OIFO/GWB - ONCOLOGY PATIENT 'COMPUTED-FIELD' EXPRESSIONS ;08/10/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
MNI ;'COMPUTED-FIELD' EXPRESSION for MIDDLE NAME (160,.015)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S NAME=$$GET1^DIQ(67,PT,.01,"E")
I $$DPTLRT(D0)="DPT" S NAME=$$GET1^DIQ(2,PT,.01,"E")
S FNMI=$P(NAME,",",2),MNI=$P(FNMI," ",2)
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=""
I $L(MNI)=2,$E(MNI,2)="." S MNI=$E(MNI,1)
S X=$E(MNI,1,14)
G EXIT
;
SA1 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 1 (160,.111)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.111,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.111,"E")
G EXIT
;
SA2 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 2 (160,.112)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.112,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.112,"E")
G EXIT
;
SA3 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 3 (160,.113)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.113,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.113,"E")
G EXIT
;
ST ;'COMPUTED-FIELD' EXPRESSION for STATE (160,.115)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.115,"I")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.115,"I")
S X=$$GET1^DIQ(5,X,1,"E")
G EXIT
;
ZIP ;'COMPUTED-FIELD' EXPRESSION for ZIP CODE (160,.116)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.116,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.116,"E")
G EXIT
;
CTY ;'COMPUTED-FIELD' EXPRESSION for CTY (160,.12) and COUNTY (160,.117)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=""
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.115,"I"),Y=$$GET1^DIQ(2,PT,.117,"I")
S X=$S(X="":"",Y="":"",1:$P($G(^DIC(5,X,1,Y,0)),U))
G EXIT
;
ZIPCT ;'COMPUTED-FIELD' EXPRESSION for ZIP-COUNTY (160,.118)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" D
.S CITY=$$GET1^DIQ(67,PT,.114,"E") S:CITY'="" CITY=CITY_", "
.S X=$$GET1^DIQ(67,PT,.115,"I")
.S STATE=$$GET1^DIQ(5,X,1,"E") S:STATE'="" STATE=STATE_" "
.S ZIP=$$GET1^DIQ(67,PT,.116,"E") S:ZIP'="" ZIP=ZIP_" "
I $$DPTLRT(D0)="DPT" D
.S CITY=$$GET1^DIQ(2,PT,.114,"E") S:CITY'="" CITY=CITY_", "
.S X=$$GET1^DIQ(2,PT,.115,"I")
.S STATE=$$GET1^DIQ(5,X,1,"E") S:STATE'="" STATE=STATE_" "
.S ZIP=$$GET1^DIQ(2,PT,.116,"E") S:ZIP'="" ZIP=ZIP_" "
.S Y=$$GET1^DIQ(2,PT,.117,"I")
.S COUNTY=$S(X="":"",Y="":"",1:$P($G(^DIC(5,X,1,Y,0)),U))
;S X=CITY_STATE_ZIP_COUNTY
S X=CITY_STATE_ZIP
G EXIT
;
ADD ;'COMPUTED-FIELD' EXPRESSION for PATIENT ADDRESS - CURRENT (160,.119)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.111,"E")_" "_$$GET1^DIQ(67,PT,.112,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.111,"E")_" "_$$GET1^DIQ(2,PT,.112,"E")
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
G EXIT
;
PH ;'COMPUTED-FIELD' EXPRESSION for TELEPHONE (160,.131)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.131,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.131,"E")
G EXIT
;
ALIAS ;'COMPUTED-FIELD' EXPRESSION for ALIAS (160,1)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=""
I $$DPTLRT(D0)="DPT" S ALIAS=0 F S ALIAS=$O(^DPT(PT,.01,ALIAS)) Q:ALIAS'>0 S X=$P(^DPT(PT,.01,ALIAS,0),U,1)
G EXIT
;
SSN ;'COMPUTED-FIELD' EXPRESSION' for SSN (160,2)
S X="",PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.09,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.09,"E")
I X?9N S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
G EXIT
;
DOB ;'COMPUTED-FIELD' EXPRESSION for DOB (160,3)
S X="",PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.03,"I")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.03,"I")
D DATEOT
G EXIT
;
DOB1 ;DOB (160,3) in internal FileMan format
S X="",PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.03,"I")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.03,"I")
G EXIT
;
TRM ;'COMPUTED-FIELD' EXPRESSION for TERMINAL DIGIT (160,4.1)
S X="",PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.09,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.09,"E")
I X?9N S X="T"_$E(X,8,9)_$E(X,6,7)_$E(X,4,5)_$E(X,1,3)
E S X=""
G EXIT
;
OCC ;'COMPUTED-FIELD' EXPRESSION for CURRENT OCCUPATION (160,12)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=""
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.07,"E")
G EXIT
;
REL ;'COMPUTED-FIELD' EXPRESSION for RELIGION (160,13)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.08,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.08,"E")
G EXIT
;
MS ;'COMPUTED-FIELD' EXPRESSION for MARITAL STATUS (160,14)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,PT,.05,"E")
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.05,"E")
G EXIT
;
EMP ;'COMPUTED-FIELD' EXPRESSION for EMPLOYMENT STATUS (160,47)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=""
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.31115,"E")
G EXIT
;
BS ;'COMPUTED-FIELD' EXPRESSION for BRANCH OF SERVICE (160,68)
S X="" S PT=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=""
I $$DPTLRT(D0)="DPT" S X=$$GET1^DIQ(2,PT,.325,"E")
G EXIT
;
HEIGHT ;'COMPUTED-FIELD' EXPRESSION for HEIGHT (160,1011)
;Supported by IA #1120
N DFN,GMRVSTR
I $P(^ONCO(160,D0,0),U,1)["LRT(67," S X=99 Q
S DFN=$P(^ONCO(160,D0,0),";",1)
S GMRVSTR="HT"
D EN6^GMRVUTL
S X=+$P(X,U,8)
S X=$J(X,0,0)
S:X>97 X=98
S:X=0 X=99
Q
;
WEIGHT ;'COMPUTED-FIELD' EXPRESSION for WEIGHT (160,1012)
;Supported by IA #1120
N DFN,GMRVSTR
I $P(^ONCO(160,D0,0),U,1)["LRT(67," S X=999 Q
S DFN=$P(^ONCO(160,D0,0),";",1)
S GMRVSTR="WT"
D EN6^GMRVUTL
S X=+$P(X,U,8)
S X=$J(X,0,0)
S:X=0 X=999
Q
;
RACE ;RACE 1 (160,8) default
N DFN,VADM
S X="",DFN=$P($G(^ONCO(160,D0,0)),";",1)
I $$DPTLRT(D0)="LRT" S X=$$GET1^DIQ(67,DFN,.06,"E") Q
I $$DPTLRT(D0)="DPT" D DEM^VADPT
S X=$P($G(VADM(12,1)),U,2)
I X="" S X=$P($G(VADM(8)),U,2)
Q
;
ENVIRON ;Environmental exposure and service indicator defaults
;AGENT ORANGE EXPOSURE (160,48)
;IONIZING RADIATION EXPOSURE (160,50)
;PERSIAN GULF SERVICE (160,51)
;LEBANON SERVICE (160,55)
;SOMALIA SERVICE (160,56)
;VIETNAM SERVICE (160,62)
;GRENADA SERVICE (160,63)
;PANAMA SERVICE (160,64)
;YUGOSLAVIA SERVICE (160,65)
;IRAQ (OIF) SERVICE (160,66)
;AFGHANISTAN (OEF) SERVICE (160,67)
I $P(^ONCO(160,D0,0),U,1)["LRT(67," D G EXIT
.S (AOE,IRE,PGS,SSI,LSI,VSI,GSI,PSI,YSI,OEF,OIF)=""
S DFN=$P(^ONCO(160,D0,0),";",1)
S AOE=$$GET1^DIQ(2,DFN,.32102,"E") ;AGENT ORANGE EXPOS. INDICATED?
S IRE=$$GET1^DIQ(2,DFN,.32103,"E") ;RADIATION EXPOSURE INDICATED?
S PGS=$$GET1^DIQ(2,DFN,.32201,"E") ;PERSIAN GULF SERVICE?
S SSI=$$GET1^DIQ(2,DFN,.322016,"E") ;SOMALIA SERVICE INDICATED?
S LSI=$$GET1^DIQ(2,DFN,.3221,"E") ;LEBANON SERVICE INDICATED?
S VSI=$$GET1^DIQ(2,DFN,.32101,"E") ;VIETNAM SERVICE INDICATED?
S GSI=$$GET1^DIQ(2,DFN,.3224,"E") ;GRENADA SERVICE INDICATED?
S PSI=$$GET1^DIQ(2,DFN,.3227,"E") ;PANAMA SERVICE INDICATED?
S YSI=$$GET1^DIQ(2,DFN,.322019,"E") ;YUGOSLAVIA SERVICE INDICATED?
S (OEF,OIF)="No"
D SVC^VADPT
I $G(VASV(11))>0 S OEF="Yes" ;SERVICE [OEF OR OIF]
I $G(VASV(12))>0 S OIF="Yes" ;SERVICE [OEF OR OIF]
G EXIT
;
TLEEOT ;TUMOR LEVEL-ENDOSCOPIC EXAM (165.5,752) OUTPUT TRANSFORM
S:$L(Y)=1 Y="0"_Y
I Y="00" S Y="Endoscopic exam not performed" Q
I Y=61 S Y="Splenic flexure" Q
I Y=62 S Y="Transverse colon" Q
I Y=63 S Y="Hepatic flexure" Q
I Y=64 S Y="Ascending colon" Q
I Y=65 S Y="Cecum" Q
I Y=70 S Y="Endoscopic exam, tumor not visualized" Q
I Y=80 S Y="Endoscopic exam, results unknown" Q
I Y=99 S Y="Unknown if exam done" Q
S Y=Y_" centimeters"
Q
;
ASPIT ;ADDITIONAL SURGICAL PROCEDURES (165.5,763)INPUT TRANSFORM
I X<10 K X Q
I "10^20^30^40^41^42^43^44^50^60^88^99"'[X K X Q
S Y=X D ASPOT W " ",Y
K Y
Q
;
ASPOT ;ADDITIONAL SURGICAL PROCEDURES (165.5,763) OUTPUT TRANSFORM
D SETASP
I Y'="" S Y=ASP(Y)
K ASP
Q
;
ASPHP ;ADDITIONAL SURGICAL PROCEDURES (165.5,763) EXECUTABLE HELP
D SETASP
F ASPX=0:0 S ASPX=$O(ASP(ASPX)) Q:ASPX'>0 W !," ",ASPX," ",ASP(ASPX)
W ! K ASP,ASPX
Q
;
SETASP ;Build ADDITIONAL SURGICAL PROCEDURES array
S ASP(10)="Transanal excision"
S ASP(20)="Posterior sacral"
S ASP(30)="Anterior resection w/o anastomosis"
S ASP(40)="Anterior resection w anastomosis, NOS"
S ASP(41)="Anterior resection w simple anastomosis"
S ASP(42)="Ant res w colo pouch coloanal anastomosis"
S ASP(43)="Anterior resection w ilioanal anastomosis"
S ASP(44)="Anterior resection w coloanal anastomosis"
S ASP(50)="Colostomy w/o resection"
S ASP(60)="Abdominoperineal resection (APR)"
S ASP(88)="NA, none performed"
S ASP(99)="Unknown if performed"
Q
;
PTRDOT ;PRIMARY TUMOR RAD DOSE (cGy) (165.5,786) OUTPUT TRANSFORM
S Y=$S($L(Y)=1:"0000"_Y,$L(Y)=2:"000"_Y,$L(Y)=3:"00"_Y,$L(Y)=4:"0"_Y,1:Y)
I Y="00000" S Y="No radiation therapy"
I Y="88888" S Y="Received radiation therapy, dose unknown"
I Y="99999" S Y="Unknown if received radiation therapy"
Q
;
DPTLRT(D0) ;Determine if patient resides in PATIENT (2) or REFERRAL PATIENT (67)
N DPTLRT
I $P($G(^ONCO(160,D0,0)),U,1)["LRT" S DPTLRT="LRT"
I $P($G(^ONCO(160,D0,0)),U,1)["DPT" S DPTLRT="DPT"
Q DPTLRT
;
DATEOT ;Date OUTPUT TRANSFORM
I X="0000000" D DD Q
I $E(X,4,5)="00" S $E(X,4,5)=99
I $E(X,6,7)="00" S $E(X,6,7)=99
D DD
Q
;
DD ;Format date values
S (X,Y)=$S(X="":"",X="0000000":"00/00/0000",X=8888888:"88/88/8888",X=9999999:"99/99/9999",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3)))
Q
;
EXIT ;Kill variables
K ALIAS,CITY,COUNTY,DFN,FNMI,MNI,ONCOX,ONCOX1,NAME,PT,STATE,VASV,Z,ZIP
Q
;
SETUP ;Old code
Q
;
CLEANUP ;Cleanup
K AOE,GSI,IRE,LSI,OEF,OIF,PGS,PSI,SSI,VSI,YSI
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOES 10473 printed Apr 09, 2024@21:27:34 Page 2
ONCOES ;Hines OIFO/GWB - ONCOLOGY PATIENT 'COMPUTED-FIELD' EXPRESSIONS ;08/10/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
MNI ;'COMPUTED-FIELD' EXPRESSION for MIDDLE NAME (160,.015)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET NAME=$$GET1^DIQ(67,PT,.01,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET NAME=$$GET1^DIQ(2,PT,.01,"E")
+4 SET FNMI=$PIECE(NAME,",",2)
SET MNI=$PIECE(FNMI," ",2)
+5 IF (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")
SET MNI=""
+6 IF $LENGTH(MNI)=2
IF $EXTRACT(MNI,2)="."
SET MNI=$EXTRACT(MNI,1)
+7 SET X=$EXTRACT(MNI,1,14)
+8 GOTO EXIT
+9 ;
SA1 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 1 (160,.111)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.111,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.111,"E")
+4 GOTO EXIT
+5 ;
SA2 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 2 (160,.112)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.112,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.112,"E")
+4 GOTO EXIT
+5 ;
SA3 ;'COMPUTED-FIELD' EXPRESSION for STREET ADDRESS 3 (160,.113)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.113,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.113,"E")
+4 GOTO EXIT
+5 ;
ST ;'COMPUTED-FIELD' EXPRESSION for STATE (160,.115)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.115,"I")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.115,"I")
+4 SET X=$$GET1^DIQ(5,X,1,"E")
+5 GOTO EXIT
+6 ;
ZIP ;'COMPUTED-FIELD' EXPRESSION for ZIP CODE (160,.116)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.116,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.116,"E")
+4 GOTO EXIT
+5 ;
CTY ;'COMPUTED-FIELD' EXPRESSION for CTY (160,.12) and COUNTY (160,.117)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=""
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.115,"I")
SET Y=$$GET1^DIQ(2,PT,.117,"I")
+4 SET X=$SELECT(X="":"",Y="":"",1:$PIECE($GET(^DIC(5,X,1,Y,0)),U))
+5 GOTO EXIT
+6 ;
ZIPCT ;'COMPUTED-FIELD' EXPRESSION for ZIP-COUNTY (160,.118)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
Begin DoDot:1
+3 SET CITY=$$GET1^DIQ(67,PT,.114,"E")
if CITY'=""
SET CITY=CITY_", "
+4 SET X=$$GET1^DIQ(67,PT,.115,"I")
+5 SET STATE=$$GET1^DIQ(5,X,1,"E")
if STATE'=""
SET STATE=STATE_" "
+6 SET ZIP=$$GET1^DIQ(67,PT,.116,"E")
if ZIP'=""
SET ZIP=ZIP_" "
End DoDot:1
+7 IF $$DPTLRT(D0)="DPT"
Begin DoDot:1
+8 SET CITY=$$GET1^DIQ(2,PT,.114,"E")
if CITY'=""
SET CITY=CITY_", "
+9 SET X=$$GET1^DIQ(2,PT,.115,"I")
+10 SET STATE=$$GET1^DIQ(5,X,1,"E")
if STATE'=""
SET STATE=STATE_" "
+11 SET ZIP=$$GET1^DIQ(2,PT,.116,"E")
if ZIP'=""
SET ZIP=ZIP_" "
+12 SET Y=$$GET1^DIQ(2,PT,.117,"I")
+13 SET COUNTY=$SELECT(X="":"",Y="":"",1:$PIECE($GET(^DIC(5,X,1,Y,0)),U))
End DoDot:1
+14 ;S X=CITY_STATE_ZIP_COUNTY
+15 SET X=CITY_STATE_ZIP
+16 GOTO EXIT
+17 ;
ADD ;'COMPUTED-FIELD' EXPRESSION for PATIENT ADDRESS - CURRENT (160,.119)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.111,"E")_" "_$$GET1^DIQ(67,PT,.112,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.111,"E")_" "_$$GET1^DIQ(2,PT,.112,"E")
+4 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+5 GOTO EXIT
+6 ;
PH ;'COMPUTED-FIELD' EXPRESSION for TELEPHONE (160,.131)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.131,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.131,"E")
+4 GOTO EXIT
+5 ;
ALIAS ;'COMPUTED-FIELD' EXPRESSION for ALIAS (160,1)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=""
+3 IF $$DPTLRT(D0)="DPT"
SET ALIAS=0
FOR
SET ALIAS=$ORDER(^DPT(PT,.01,ALIAS))
if ALIAS'>0
QUIT
SET X=$PIECE(^DPT(PT,.01,ALIAS,0),U,1)
+4 GOTO EXIT
+5 ;
SSN ;'COMPUTED-FIELD' EXPRESSION' for SSN (160,2)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.09,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.09,"E")
+4 IF X?9N
SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,9)
+5 GOTO EXIT
+6 ;
DOB ;'COMPUTED-FIELD' EXPRESSION for DOB (160,3)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.03,"I")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.03,"I")
+4 DO DATEOT
+5 GOTO EXIT
+6 ;
DOB1 ;DOB (160,3) in internal FileMan format
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.03,"I")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.03,"I")
+4 GOTO EXIT
+5 ;
TRM ;'COMPUTED-FIELD' EXPRESSION for TERMINAL DIGIT (160,4.1)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.09,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.09,"E")
+4 IF X?9N
SET X="T"_$EXTRACT(X,8,9)_$EXTRACT(X,6,7)_$EXTRACT(X,4,5)_$EXTRACT(X,1,3)
+5 IF '$TEST
SET X=""
+6 GOTO EXIT
+7 ;
OCC ;'COMPUTED-FIELD' EXPRESSION for CURRENT OCCUPATION (160,12)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=""
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.07,"E")
+4 GOTO EXIT
+5 ;
REL ;'COMPUTED-FIELD' EXPRESSION for RELIGION (160,13)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.08,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.08,"E")
+4 GOTO EXIT
+5 ;
MS ;'COMPUTED-FIELD' EXPRESSION for MARITAL STATUS (160,14)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,PT,.05,"E")
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.05,"E")
+4 GOTO EXIT
+5 ;
EMP ;'COMPUTED-FIELD' EXPRESSION for EMPLOYMENT STATUS (160,47)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=""
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.31115,"E")
+4 GOTO EXIT
+5 ;
BS ;'COMPUTED-FIELD' EXPRESSION for BRANCH OF SERVICE (160,68)
+1 SET X=""
SET PT=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+2 IF $$DPTLRT(D0)="LRT"
SET X=""
+3 IF $$DPTLRT(D0)="DPT"
SET X=$$GET1^DIQ(2,PT,.325,"E")
+4 GOTO EXIT
+5 ;
HEIGHT ;'COMPUTED-FIELD' EXPRESSION for HEIGHT (160,1011)
+1 ;Supported by IA #1120
+2 NEW DFN,GMRVSTR
+3 IF $PIECE(^ONCO(160,D0,0),U,1)["LRT(67,"
SET X=99
QUIT
+4 SET DFN=$PIECE(^ONCO(160,D0,0),";",1)
+5 SET GMRVSTR="HT"
+6 DO EN6^GMRVUTL
+7 SET X=+$PIECE(X,U,8)
+8 SET X=$JUSTIFY(X,0,0)
+9 if X>97
SET X=98
+10 if X=0
SET X=99
+11 QUIT
+12 ;
WEIGHT ;'COMPUTED-FIELD' EXPRESSION for WEIGHT (160,1012)
+1 ;Supported by IA #1120
+2 NEW DFN,GMRVSTR
+3 IF $PIECE(^ONCO(160,D0,0),U,1)["LRT(67,"
SET X=999
QUIT
+4 SET DFN=$PIECE(^ONCO(160,D0,0),";",1)
+5 SET GMRVSTR="WT"
+6 DO EN6^GMRVUTL
+7 SET X=+$PIECE(X,U,8)
+8 SET X=$JUSTIFY(X,0,0)
+9 if X=0
SET X=999
+10 QUIT
+11 ;
RACE ;RACE 1 (160,8) default
+1 NEW DFN,VADM
+2 SET X=""
SET DFN=$PIECE($GET(^ONCO(160,D0,0)),";",1)
+3 IF $$DPTLRT(D0)="LRT"
SET X=$$GET1^DIQ(67,DFN,.06,"E")
QUIT
+4 IF $$DPTLRT(D0)="DPT"
DO DEM^VADPT
+5 SET X=$PIECE($GET(VADM(12,1)),U,2)
+6 IF X=""
SET X=$PIECE($GET(VADM(8)),U,2)
+7 QUIT
+8 ;
ENVIRON ;Environmental exposure and service indicator defaults
+1 ;AGENT ORANGE EXPOSURE (160,48)
+2 ;IONIZING RADIATION EXPOSURE (160,50)
+3 ;PERSIAN GULF SERVICE (160,51)
+4 ;LEBANON SERVICE (160,55)
+5 ;SOMALIA SERVICE (160,56)
+6 ;VIETNAM SERVICE (160,62)
+7 ;GRENADA SERVICE (160,63)
+8 ;PANAMA SERVICE (160,64)
+9 ;YUGOSLAVIA SERVICE (160,65)
+10 ;IRAQ (OIF) SERVICE (160,66)
+11 ;AFGHANISTAN (OEF) SERVICE (160,67)
+12 IF $PIECE(^ONCO(160,D0,0),U,1)["LRT(67,"
Begin DoDot:1
+13 SET (AOE,IRE,PGS,SSI,LSI,VSI,GSI,PSI,YSI,OEF,OIF)=""
End DoDot:1
GOTO EXIT
+14 SET DFN=$PIECE(^ONCO(160,D0,0),";",1)
+15 ;AGENT ORANGE EXPOS. INDICATED?
SET AOE=$$GET1^DIQ(2,DFN,.32102,"E")
+16 ;RADIATION EXPOSURE INDICATED?
SET IRE=$$GET1^DIQ(2,DFN,.32103,"E")
+17 ;PERSIAN GULF SERVICE?
SET PGS=$$GET1^DIQ(2,DFN,.32201,"E")
+18 ;SOMALIA SERVICE INDICATED?
SET SSI=$$GET1^DIQ(2,DFN,.322016,"E")
+19 ;LEBANON SERVICE INDICATED?
SET LSI=$$GET1^DIQ(2,DFN,.3221,"E")
+20 ;VIETNAM SERVICE INDICATED?
SET VSI=$$GET1^DIQ(2,DFN,.32101,"E")
+21 ;GRENADA SERVICE INDICATED?
SET GSI=$$GET1^DIQ(2,DFN,.3224,"E")
+22 ;PANAMA SERVICE INDICATED?
SET PSI=$$GET1^DIQ(2,DFN,.3227,"E")
+23 ;YUGOSLAVIA SERVICE INDICATED?
SET YSI=$$GET1^DIQ(2,DFN,.322019,"E")
+24 SET (OEF,OIF)="No"
+25 DO SVC^VADPT
+26 ;SERVICE [OEF OR OIF]
IF $GET(VASV(11))>0
SET OEF="Yes"
+27 ;SERVICE [OEF OR OIF]
IF $GET(VASV(12))>0
SET OIF="Yes"
+28 GOTO EXIT
+29 ;
TLEEOT ;TUMOR LEVEL-ENDOSCOPIC EXAM (165.5,752) OUTPUT TRANSFORM
+1 if $LENGTH(Y)=1
SET Y="0"_Y
+2 IF Y="00"
SET Y="Endoscopic exam not performed"
QUIT
+3 IF Y=61
SET Y="Splenic flexure"
QUIT
+4 IF Y=62
SET Y="Transverse colon"
QUIT
+5 IF Y=63
SET Y="Hepatic flexure"
QUIT
+6 IF Y=64
SET Y="Ascending colon"
QUIT
+7 IF Y=65
SET Y="Cecum"
QUIT
+8 IF Y=70
SET Y="Endoscopic exam, tumor not visualized"
QUIT
+9 IF Y=80
SET Y="Endoscopic exam, results unknown"
QUIT
+10 IF Y=99
SET Y="Unknown if exam done"
QUIT
+11 SET Y=Y_" centimeters"
+12 QUIT
+13 ;
ASPIT ;ADDITIONAL SURGICAL PROCEDURES (165.5,763)INPUT TRANSFORM
+1 IF X<10
KILL X
QUIT
+2 IF "10^20^30^40^41^42^43^44^50^60^88^99"'[X
KILL X
QUIT
+3 SET Y=X
DO ASPOT
WRITE " ",Y
+4 KILL Y
+5 QUIT
+6 ;
ASPOT ;ADDITIONAL SURGICAL PROCEDURES (165.5,763) OUTPUT TRANSFORM
+1 DO SETASP
+2 IF Y'=""
SET Y=ASP(Y)
+3 KILL ASP
+4 QUIT
+5 ;
ASPHP ;ADDITIONAL SURGICAL PROCEDURES (165.5,763) EXECUTABLE HELP
+1 DO SETASP
+2 FOR ASPX=0:0
SET ASPX=$ORDER(ASP(ASPX))
if ASPX'>0
QUIT
WRITE !," ",ASPX," ",ASP(ASPX)
+3 WRITE !
KILL ASP,ASPX
+4 QUIT
+5 ;
SETASP ;Build ADDITIONAL SURGICAL PROCEDURES array
+1 SET ASP(10)="Transanal excision"
+2 SET ASP(20)="Posterior sacral"
+3 SET ASP(30)="Anterior resection w/o anastomosis"
+4 SET ASP(40)="Anterior resection w anastomosis, NOS"
+5 SET ASP(41)="Anterior resection w simple anastomosis"
+6 SET ASP(42)="Ant res w colo pouch coloanal anastomosis"
+7 SET ASP(43)="Anterior resection w ilioanal anastomosis"
+8 SET ASP(44)="Anterior resection w coloanal anastomosis"
+9 SET ASP(50)="Colostomy w/o resection"
+10 SET ASP(60)="Abdominoperineal resection (APR)"
+11 SET ASP(88)="NA, none performed"
+12 SET ASP(99)="Unknown if performed"
+13 QUIT
+14 ;
PTRDOT ;PRIMARY TUMOR RAD DOSE (cGy) (165.5,786) OUTPUT TRANSFORM
+1 SET Y=$SELECT($LENGTH(Y)=1:"0000"_Y,$LENGTH(Y)=2:"000"_Y,$LENGTH(Y)=3:"00"_Y,$LENGTH(Y)=4:"0"_Y,1:Y)
+2 IF Y="00000"
SET Y="No radiation therapy"
+3 IF Y="88888"
SET Y="Received radiation therapy, dose unknown"
+4 IF Y="99999"
SET Y="Unknown if received radiation therapy"
+5 QUIT
+6 ;
DPTLRT(D0) ;Determine if patient resides in PATIENT (2) or REFERRAL PATIENT (67)
+1 NEW DPTLRT
+2 IF $PIECE($GET(^ONCO(160,D0,0)),U,1)["LRT"
SET DPTLRT="LRT"
+3 IF $PIECE($GET(^ONCO(160,D0,0)),U,1)["DPT"
SET DPTLRT="DPT"
+4 QUIT DPTLRT
+5 ;
DATEOT ;Date OUTPUT TRANSFORM
+1 IF X="0000000"
DO DD
QUIT
+2 IF $EXTRACT(X,4,5)="00"
SET $EXTRACT(X,4,5)=99
+3 IF $EXTRACT(X,6,7)="00"
SET $EXTRACT(X,6,7)=99
+4 DO DD
+5 QUIT
+6 ;
DD ;Format date values
+1 SET (X,Y)=$SELECT(X="":"",X="0000000":"00/00/0000",X=8888888:"88/88/8888",X=9999999:"99/99/9999",1:$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_(1700+$EXTRACT(X,1,3)))
+2 QUIT
+3 ;
EXIT ;Kill variables
+1 KILL ALIAS,CITY,COUNTY,DFN,FNMI,MNI,ONCOX,ONCOX1,NAME,PT,STATE,VASV,Z,ZIP
+2 QUIT
+3 ;
SETUP ;Old code
+1 QUIT
+2 ;
CLEANUP ;Cleanup
+1 KILL AOE,GSI,IRE,LSI,OEF,OIF,PGS,PSI,SSI,VSI,YSI
