source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCFUNC.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1ONCFUNC ;Hines OIFO/GWB - ONCOLOGY FUNCTIONS ;05/26/00
2 ;;2.11;ONCOLOGY;**24,25,26,27,28,30,32,33,35,36,41**;Mar 07, 1995
3 ;
4SHN() ;STATE HOSPITAL NUMBER (160.1,1.03)
5 N OSP
6 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
7 I OSP="" S OSP=$O(^ONCO(160.1,0))
8 S SHN=$$GET1^DIQ(160.1,OSP,1.03,"I")
9 Q SHN
10IIN() ;INSTITUTION ID NUMBER (160.1,27)
11 N OSP
12 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
13 I OSP="" S OSP=$O(^ONCO(160.1,0))
14 S IIN=$$GET1^DIQ(160.1,OSP,27,"I")
15 S IIN=$$GET1^DIQ(160.19,IIN,.01,"I")
16 Q IIN
17FLNAME(NAME) ;
18 S TNAME=NAME,DFN=D0
19 D NAME^VAFCPID2(DFN,.TNAME,0)
20 ; make sure 3rd parameter in above call is 0 or it will update ^DPT(DFN
21 ; put name in format LAST,FIRST MIDDLE SUFFIX
22 S LAST=$P(TNAME,","),TNAME=$P(TNAME,",",2)
23 S FIRST=$P(TNAME," "),MIDDLE=$P(TNAME," ",2)
24 S SUFFIX=$P(TNAME," ",3)
25 I MIDDLE["""" S MIDDLE=""
26 S TNAME=FIRST_" "_MIDDLE_" "_LAST_" "_SUFFIX
27SP I $F(TNAME," ") S PL=$F(TNAME," "),TNAME=$E(TNAME,1,PL-2)_$E(TNAME,PL,$L(TNAME)) G SP
28 Q TNAME
29DIV(IEN) ;DIVISION (165.5,2000)
30 N DIV
31 S DIV=$G(^ONCO(165.5,IEN,"DIV"))
32 Q DIV
33 ;
34SUSDIV(IEN,SUSIEN) ;DIVISION (160,30)
35 N DIV
36 S DIV=$P($G(^ONCO(160,IEN,"SUS",SUSIEN,0)),U,4)
37 Q DIV
38 ;
39PFTD(IEN) ;Primaries for this division
40 N PFTD
41 S PFTD="N"
42 S PRI=0 F S PRI=$O(^ONCO(165.5,"C",IEN,PRI)) Q:PRI'>0 I $P($G(^ONCO(165.5,PRI,"DIV")),U,1)=DUZ(2) S PFTD="Y"
43 Q PFTD
44 ;
45PRICNT ;TOTAL PRIMARIES FOR PATIENT (160,17)
46 S PRI=0,PRICNT=0 F S PRI=$O(^ONCO(165.5,"C",D0,PRI)) Q:PRI'>0 I $P($G(^ONCO(165.5,PRI,"DIV")),U,1)=DUZ(2) D
47 .S PRICNT=PRICNT+1
48 S X=PRICNT K PRI,PRICNT
49 Q
50 ;
51DIDIV(IEN) ;Disease Index Division screen
52 N DIVMATCH
53 S DIVMATCH="N"
54 S VIPNT=$P($G(^AUPNVPOV(D0,0)),U,3) G:VIPNT="" DIDIVEX
55 S HLPNT=$P($G(^AUPNVSIT(VIPNT,0)),U,22) G:HLPNT="" DIDIVEX
56 S MCPNT=$P($G(^SC(HLPNT,0)),U,15) G:MCPNT="" DIDIVEX
57 S INPNT=$P($G(^DG(40.8,MCPNT,0)),U,7)
58 I (INPNT=DUZ(2))!(AFLDIV[INPNT) S DIVMATCH="Y"
59DIDIVEX K VIPNT,HLPNT,MCPNT,INPNT
60 Q DIVMATCH
61 ;
62HIST(IEN) ;Histology ICD-O-2 (165.5,22) or Histology ICD-O-3 (165.5,22.3)
63 S ONCDTDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
64 S ICDNUM=3 I ONCDTDX<3010000 S ICDNUM=2
65 S HNODE=$S(ICDNUM=3:2.2,1:2),ICDFILE=$S(ICDNUM=3:169.3,1:164.1)
66 S HSTFLD=$S(ICDNUM=3:22.3,1:22)
67 S HISTICD=$P($G(^ONCO(165.5,IEN,HNODE)),U,3)
68 S HISTNAM=""
69 I HISTICD'="" S HISTNAM=$P($G(^ONCO(ICDFILE,HISTICD,0)),U,1)
70 Q HISTICD
71 ;
72LYMPHOMA(IEN) ;Hodgkin and Non-Hodgin Lymphomas
73 N LYMPHOMA
74 S LYMPHOMA=0
75 S HSTICD=$$HIST^ONCFUNC(IEN)
76 S HST123=$E(HSTICD,1,3)
77 I ONCDTDX<3010000,(HST123>958)&(HST123<972) S LYMPHOMA=1
78 I ONCDTDX>3001231,(HST123>958)&(HST123<973) S LYMPHOMA=1
79 K HSTICD,HST123,ONCDTDX
80 Q LYMPHOMA
81 ;
82CC ;COMORBIDITY/COMPLICATION #1-6 screen
83 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>7.1)&+($E($P(^ICD9(Y,0),U,1),2,9)<7.4) Q
84 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>9.91)&+($E($P(^ICD9(Y,0),U,1),2,9)<16) Q
85 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>21.9)&+($E($P(^ICD9(Y,0),U,1),2,9)<23.2) Q
86 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>25.3)&+($E($P(^ICD9(Y,0),U,1),2,9)<25.5) Q
87 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>43.89)&+($E($P(^ICD9(Y,0),U,1),2,9)<46) Q
88 I $E($P(^ICD9(Y,0),U,1),1)="V",+($E($P(^ICD9(Y,0),U,1),2,9)>50.4)&+($E($P(^ICD9(Y,0),U,1),2,9)<50.8) Q
89 I $E($P(^ICD9(Y,0),U,1),1)'="V",$E($P(^ICD9(Y,0),U,1),1)="E",($E($P(^ICD9(Y,0),U,1),2,9)>869.9)&($E($P(^ICD9(Y,0),U,1),2,9)<880) Q
90 I $E($P(^ICD9(Y,0),U,1),1)'="V",$E($P(^ICD9(Y,0),U,1),1)="E",($E($P(^ICD9(Y,0),U,1),2,9)>929.9)&($E($P(^ICD9(Y,0),U,1),2,9)<950) Q
91 I $E($P(^ICD9(Y,0),U,1),1)'="V",$E($P(^ICD9(Y,0),U,1),1)'="E",($P(^ICD9(Y,0),U,1)<140)!($P(^ICD9(Y,0),U,1)>239.9) Q
92 Q
93 ;
94DSTS(IEN) ;DATE SYSTEMIC THERAPY STARTED
95 N X
96 S X=$$GET1^DIQ(165.5,IEN,53,"I") I X'="" S DSTSDT(X)=""
97 S X=$$GET1^DIQ(165.5,IEN,54,"I") I X'="" S DSTSDT(X)=""
98 S X=$$GET1^DIQ(165.5,IEN,55,"I") I X'="" S DSTSDT(X)=""
99 S DSTS=$O(DSTSDT(0))
100 S X=$$DATE^ONCACDU1(DSTS)
101 K DSTSDT,DSTS
102 Q X
Note: See TracBrowser for help on using the repository browser.