| 1 | ONCOCOM ;Hines OIFO/GWB - 'COMPUTED FIELD' EXPRESSIONS ;02/10/00
|
|---|
| 2 | ;;2.11;ONCOLOGY;**1,6,11,12,13,14,16,17,19,25,36,42,43,44,46,47**;Mar 07, 1995;Build 19
|
|---|
| 3 | ;
|
|---|
| 4 | SDA ;List all primaries from 165.5
|
|---|
| 5 | S XD0=$P(^ONCO(165.5,D0,0),U,2) G CX
|
|---|
| 6 | ;
|
|---|
| 7 | SDP ;get Other Primary Sites & dates Diagnosis: from 165.5
|
|---|
| 8 | D XD0 G:XD0="" EX
|
|---|
| 9 | D ;List all primaries except current primary
|
|---|
| 10 | X N J S J=0
|
|---|
| 11 | F XD1=0:0 S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) G:XD1'>0 NO I $$DIV^ONCFUNC(XD1)=DUZ(2),$D(^ONCO(165.5,XD1,0)),XD1'=D0 S J=J+1 W:J=1 ?1,"Acc/Seq#",?15,"Primary Site",?37,"Last Tumor Status",?56,"Date DX",?68,"Status",! D ^ONCOCOML
|
|---|
| 12 | ;
|
|---|
| 13 | NO ;No other primaries
|
|---|
| 14 | G:J>0 EX W ?24,"None" G EX
|
|---|
| 15 | ;
|
|---|
| 16 | SDD ;List primaries
|
|---|
| 17 | Q:'$D(^ONCO(160,D0)) S XD0=D0
|
|---|
| 18 | CX ;Entry point with XD0 defined, not D0
|
|---|
| 19 | N J,XD1,LINE W !!
|
|---|
| 20 | S LINE=" ------------- -------------------- ----------------- ---------- -----------"
|
|---|
| 21 | S J=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $D(^ONCO(165.5,XD1,0)),$$DIV^ONCFUNC(XD1)=DUZ(2) S J=J+1 W:J=1 " Acc/Sequence",?15,"Primary Site",?37,"Last Tumor Status",?56,"Date DX",?68,"Status",!,LINE,! D ^ONCOCOML
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | CLS ;CLass of Case (ANALYTIC/NON-ANALYTIC)
|
|---|
| 25 | ;Computed field (165.5, .042) CASE-CLASS
|
|---|
| 26 | S XD0=D0,X=$S($D(^ONCO(165.5,XD0,0)):$P(^(0),U,4),1:""),X=$S(X="":"",X<3:"Analytic",1:"Non-Analytic")
|
|---|
| 27 | K XD0 Q
|
|---|
| 28 | ;
|
|---|
| 29 | DFC ;'COMPUTED-FIELD' EXPRESSION for FIRST COURSE OF TREATMENT DATE (165.5,49)
|
|---|
| 30 | I '$D(^ONCO(165.5,"ATX",D0)) S X="" Q
|
|---|
| 31 | S TDT=0 F S TDT=$O(^ONCO(165.5,"ATX",D0,TDT)) Q:TDT="" Q:($E(TDT,1,7)'="0000000")&($E(TDT,1,7)'=9999999)&($E(TDT,1,7)'=8888888)&($E(TDT,8,9)'="S2")&($E(TDT,8,9)'="S3")
|
|---|
| 32 | I TDT="" S TDT=0 F S TDT=$O(^ONCO(165.5,"ATX",D0,TDT)) Q:TDT="" Q:$E(TDT,1,7)=9999999
|
|---|
| 33 | I TDT="" S TDT=0 F S TDT=$O(^ONCO(165.5,"ATX",D0,TDT)) Q:TDT="" Q:$E(TDT,1,7)="0000000"
|
|---|
| 34 | I TDT="" S TDT="9999999X"
|
|---|
| 35 | S X=$E(TDT,1,7)
|
|---|
| 36 | D DATEOT^ONCOES
|
|---|
| 37 | K TDT Q
|
|---|
| 38 | ;
|
|---|
| 39 | DSTS ;DATE SYSTEMIC TREATMENT STARTED (165.5,152)
|
|---|
| 40 | S DSTS=""
|
|---|
| 41 | K DSTSDT
|
|---|
| 42 | S X=$$GET1^DIQ(165.5,D0,53,"I") I X'="" S DSTSDT(X)=""
|
|---|
| 43 | S X=$$GET1^DIQ(165.5,D0,54,"I") I X'="" S DSTSDT(X)=""
|
|---|
| 44 | S X=$$GET1^DIQ(165.5,D0,55,"I") I X'="" S DSTSDT(X)=""
|
|---|
| 45 | S X=$$GET1^DIQ(165.5,D0,153.1,"I") I X'="" S DSTSDT(X)=""
|
|---|
| 46 | S DSTS=0 F S DSTS=$O(DSTSDT(DSTS)) Q:DSTS="" Q:($E(DSTS,1,7)'="0000000")&($E(DSTS,1,7)'=9999999)
|
|---|
| 47 | I DSTS="" S DSTS=0 F S DSTS=$O(DSTSDT(DSTS)) Q:DSTS="" Q:$E(DSTS,1,7)=9999999
|
|---|
| 48 | I DSTS="" S DSTS=0 F S DSTS=$O(DSTSDT(DSTS)) Q:DSTS="" Q:$E(DSTS,1,7)="0000000"
|
|---|
| 49 | S X=DSTS
|
|---|
| 50 | D DATEOT^ONCOES
|
|---|
| 51 | K DSTS,DSTSDT
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | DD ;Y=date in FM format (2yrmoda); convert to da/mo/yr
|
|---|
| 55 | S Y=$S(Y="":"",1:$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))) ;_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"0000",11,12),1:"")
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | AGE ;AGE AT DIAGNOSIS
|
|---|
| 59 | S DOD=$P(^ONCO(165.5,D0,0),U,16) I DOD="" S AGE="" G AGEOUT
|
|---|
| 60 | S XD0=D0,D0=$P(^ONCO(165.5,XD0,0),U,2) D DOB1^ONCOES S DOB=X,D0=XD0
|
|---|
| 61 | I DOB="" S AGE="" G AGEOUT
|
|---|
| 62 | S AGE=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7))
|
|---|
| 63 | ;
|
|---|
| 64 | AGEOUT S X=AGE K DOD,XD0,DOB,AGE
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | DEC ;AGE DX DECADE
|
|---|
| 68 | D AGE Q:X="" S AG=X,X=$S(AG<20:"0-20",AG<30:"20-29",AG<40:"30-39",AG<50:"40-49",AG<60:"50-59",AG<70:"60-69",AG<80:"70-79",1:"80-99")
|
|---|
| 69 | K AG Q
|
|---|
| 70 | XD0 S XD0=$S($D(^ONCO(165.5,D0,0)):$P(^(0),U,2),1:"") ;XD0=internal 160
|
|---|
| 71 | Q
|
|---|
| 72 | PAT ;Get Patient pointer
|
|---|
| 73 | V0 S OD0=$S($D(^ONCO(160,XD0,0)):$P(^(0),U),1:"") Q:OD0="" S OF=$P(OD0,";",2),OD0=$P(OD0,";",1),VPR=U_OF_OD0_",0)",VP0=$S($D(@VPR):^(0),1:"")
|
|---|
| 74 | Q
|
|---|
| 75 | PID ;PATIENT NAME,SSN,DOB
|
|---|
| 76 | S X="" D PAT G EX:OD0="" S ONCONM=$P(VP0,U),SN=$P(VP0,U,9),XD=$P(VP0,U,3),ONCOPID=$E(ONCONM)_$E(SN,6,9)
|
|---|
| 77 | Q
|
|---|
| 78 | SID ;PID# (A1234)
|
|---|
| 79 | PID5 S XD0=$P(^ONCO(165.5,D0,0),U,2) D PAT,PID S X=$E(ONCONM)_$E(SN,6,9) G EX
|
|---|
| 80 | ;
|
|---|
| 81 | PID0 S XD0=D0 D PAT,PID S X=$E(ONCONM)_$E(SN,6,9) G EX
|
|---|
| 82 | ;
|
|---|
| 83 | MS ;Marital status at Diagnosis FROM 165.5
|
|---|
| 84 | S X="" D XD0 G:XD0="" EX D PAT G:OD0="" EX S MS=$P(VP0,U,5),MC=$P($G(^DIC(11,+MS,0)),U,3),X1=$S(MC="N":1,MC="M":2,MC="S":3,MC="D":4,MC="W":5,1:9),$P(^ONCO(165.5,D0,1),U,5)=X1
|
|---|
| 85 | ADX ;Address at DX
|
|---|
| 86 | PT S GLR=U_OF_OD0_",",X11=$G(@(GLR_".11)")),CITY=$P(X11,U,4),ST=$P(X11,U,5),CT=$P(X11,U,7),ZIP=$P(X11,U,6),ZP=$O(^VIC(5.11,"B",ZIP_" ",0))
|
|---|
| 87 | I CITY'="" S $P(^ONCO(165.5,D0,1),U,12)=CITY
|
|---|
| 88 | I ST'="" S STDXABV=$P($G(^DIC(5,ST,0)),U,2),STDXIEN=$O(^ONCO(160.15,"B",STDXABV,"")),$P(^ONCO(165.5,D0,1),U,4)=STDXIEN
|
|---|
| 89 | S ADX=$P(X11,U)_" "_$P(X11,U,2)_U_ZIP,$P(^ONCO(165.5,D0,1),U,1)=$S($P(ADX,U,1)=" ":"",1:$P(ADX,U,1)),$P(^ONCO(165.5,D0,1),U,2)=$P(ADX,U,2) D CTY G EX
|
|---|
| 90 | CTY ;Obtain county ptr
|
|---|
| 91 | Q:ST=""!(CT="") I $D(^DIC(5,ST,1,CT,0)) S CTY=$P(^(0),U),VI=0 F S VI=$O(^VIC(5.1,"B",CTY,VI)) Q:VI'>0 I $P(^VIC(5.1,VI,0),U,2)=ST S $P(^ONCO(165.5,D0,1),U,3)=VI
|
|---|
| 92 | Q
|
|---|
| 93 | ONCPRI ;ICD0-TOPOGRAPHY LIST (160,49)
|
|---|
| 94 | S XD0=0
|
|---|
| 95 | F S XD0=$O(^ONCO(165.5,"C",D0,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2) D
|
|---|
| 96 | .Q:'$D(^ONCO(165.5,XD0,2))
|
|---|
| 97 | .S TOPIEN=$P(^ONCO(165.5,XD0,2),U,1)
|
|---|
| 98 | .Q:TOPIEN=""
|
|---|
| 99 | .S TOPNAME=$P(^ONCO(164,TOPIEN,0),U,1)
|
|---|
| 100 | .S TOPCODE=$P(^ONCO(164,TOPIEN,0),U,2)
|
|---|
| 101 | .S TOP(TOPCODE)=TOPNAME
|
|---|
| 102 | I $D(TOP) S TOPCODE="" W ! F S TOPCODE=$O(TOP(TOPCODE)) Q:TOPCODE="" W ?5,TOP(TOPCODE),!
|
|---|
| 103 | S X="" K XD0,TOPIEN,TOP,TOPCODE Q
|
|---|
| 104 | ACOS ;'COMPUTED-FIELD' EXPRESSION for ACOS # (165.5,67)
|
|---|
| 105 | S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|---|
| 106 | I OSP="" S OSP=$O(^ONCO(160.1,0))
|
|---|
| 107 | S ACOS=$P(^ONCO(160.1,OSP,0),U,4)
|
|---|
| 108 | S ACOS=$$GET1^DIQ(160.19,ACOS,.01,"I")
|
|---|
| 109 | S X=ACOS K OSP,ACOS
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | HM ;'COMPUTED-FIELD' EXPRESSION for HISTO-MORPHOLOGY (165.5,27)
|
|---|
| 113 | N MO,GRADE
|
|---|
| 114 | S X=""
|
|---|
| 115 | S MO=$$GET1^DIQ(165.5,D0,22.3,"I")
|
|---|
| 116 | I MO'="" D
|
|---|
| 117 | .S GRADE=$$GET1^DIQ(165.5,D0,24,"I")
|
|---|
| 118 | .S X=$E(MO,1,4)_"/"_$E(MO,5)_GRADE
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | ET ;'COMPUTED-FIELD' EXPRESSION for ELAPSED DAYS TO COMPLETION (165.5,157)
|
|---|
| 122 | N DATE1,DATE2
|
|---|
| 123 | S DATE1=$P($G(^ONCO(165.5,D0,7)),U,1)
|
|---|
| 124 | S DATE2=$P($G(^ONCO(165.5,D0,0)),U,35)
|
|---|
| 125 | I (DATE2="")!(DATE2="0000000")!(DATE2=9999999) S X="Unknown (No Date of First Contact)" Q
|
|---|
| 126 | I (DATE1="")!(DATE1="0000000")!(DATE1=9999999)!(DATE1=8888888) S X="Unknown (No Date Case Completed)" Q
|
|---|
| 127 | I DATE1<DATE2 S X="Unknown (Dt 1st Cont > Dt Case Complt)" Q
|
|---|
| 128 | S X1=DATE1
|
|---|
| 129 | S X2=DATE2
|
|---|
| 130 | D ^%DTC
|
|---|
| 131 | I %Y=0 S X="Unknown (Dates imprecise)" Q
|
|---|
| 132 | ;S X=X_$S(X=1:" day",1:" days")
|
|---|
| 133 | ;D DTDIFF^ONCDTUTL(DATE1,DATE2,.DAYS,.MONTHS,.YEARS)
|
|---|
| 134 | ;I ($E(DATE1,4,5)="00")!($E(DATE2,4,5)="00") S MONTHS="?"
|
|---|
| 135 | ;I ($E(DATE1,6,7)="00")!($E(DATE2,6,7)="00") S DAYS="?"
|
|---|
| 136 | ;S X=YEARS_$S(YEARS=1:" Year/",1:" Years/")_MONTHS_$S(MONTHS=1:" Month/",1:" Months/")_DAYS_$S(DAYS=1:" Day",1:" Days")
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | DCD ;INPUT TRANSFORM for DATE OF CONCLUSIVE DX (165.5,193)
|
|---|
| 140 | N DCDX,X1,X2,%Y
|
|---|
| 141 | S DCDX=X
|
|---|
| 142 | S X2=$P($G(^ONCO(165.5,D0,0)),U,16)
|
|---|
| 143 | S X1=X
|
|---|
| 144 | I (X2="")!(X2="0000000")!(X2=8888888)!(X2=9999999) Q
|
|---|
| 145 | I X2>X1 W !!,"DATE DX after DATE OF CONCLUSIVE DX",! K X Q
|
|---|
| 146 | D ^%DTC
|
|---|
| 147 | I %Y=0 Q
|
|---|
| 148 | I X<61 W !!," DATE OF CONCLUSIVE DX must be greater than 60 days after DATE DX",! K X Q
|
|---|
| 149 | S X=DCDX
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | SET ;SET VARIABLES
|
|---|
| 153 | K SDD,XTS,ABS,SD,ACS,ST Q
|
|---|
| 154 | EX ;KILL ALL VARIABLES
|
|---|
| 155 | K ACS,ADX,CT,CTY,GLR,OD0,X11,ZIP,ZP,VI,MS,ST,SD,SDD,XD1,X1,X2,XD0,OD0,OF,VPR,VP0,Y
|
|---|
| 156 | Q
|
|---|
