source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOCRC.m@ 1015

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1ONCOCRC ;Hines OIFO/GWB,RTK-STUFF FIELDS, SPECIAL CROSS REFERENCES;8/19/93
2 ;;2.11;ONCOLOGY;**1,6,11,13,15,28**;Mar 07, 1995
3 ;CLASS OF CASE=> CLASS CATEFORY
4SAG ;SET CLASS CATEGORY #.042;0;20
5 S XD0=DA,CC=$S(X="":"",X>2:0,X="A":1,X="NA":0,1:1)
6 I CC'="" D SXF
7 G EX
8 ;
9KXF ;KILL OLD CROSS REF
10 S XCC=$P(^ONCO(165.5,XD0,0),U,20) Q:XCC="" S $P(^ONCO(165.5,XD0,0),U,20)="" K ^ONCO(165.5,"AG",XCC,DA) Q
11 ;
12SXF ;STUFF #.042 CLASS-CATEGORY, AND SET NEW CROSS REFERENCE
13 S $P(^ONCO(165.5,XD0,0),U,20)=CC,^ONCO(165.5,"AG",CC,DA)="" Q
14 ;
15KAG ;KILL STATEMENT for trigger
16 S XD0=DA D KXF Q
17 ;
18SACL ;Reset next accession number
19 Q:'$D(ONCOACL) S XY=$E(X,1,2),XAC=$E(X,3,6) K ^ONCO(165.5,"XACD",XY,XAC)
20 I '$D(^ONCO(165.5,"ACL",XY)) S ^ONCO(165.5,"ACL",XY)=XAC G EX
21 G EX:'(XAC>^ONCO(165.5,"ACL",XY)) K ^ONCO(165.5,"ACL",XY) S ^ONCO(165.5,"ACL",XY)=XAC G EX
22 ;
23KACL ;KILL FOR NEXT Accession Number
24 Q:'$D(ONCOACL) Q:$D(^ONCO(165.5,"AE",X)) S XY=$E(X,1,2),XAC=$E(X,3,6),XX=$G(^ONCO(165.5,"ACL",XY)) G EX:XX="" I XX>XAC S ^ONCO(165.5,"ACD",XY,XAC)="" G EX
25 I XAC>^ONCO(165.5,"ACL",XY) W !!,?5,"ERROR in Accession Numbers - call Developer",!! G EX
26 K ^ONCO(165.5,"ACL",XY) F J=1:1 S XAC=XAC-1 S XX=$E(XAC,3,6) G EX:XX="0000" I $D(^ONCO(165.5,"AE",XAC)) S ^ONCO(165.5,"ACL",XY)=XX G EX
27 ;
28 Q
29PSSG ;SET AJCC SUMMARY STAGE GROUP from PATHOLOGIC STAGE GROUP (#88) FIELD
30 N SG,XD0
31 S XD0=DA
32 S CSG=$P($G(^ONCO(165.5,DA,2)),U,20),CSGD="" I CSG'="" S CSG=$E(CSG)
33 I CSG'="" S CSGD=$S(CSG=0:0,CSG=1:"I",CSG=2:"II",CSG=3:"III",CSG=4:"IV",CSG=9:"U",CSG=8:"NA",1:"")
34 S SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(CSG>7):"U",SG=9&(CSG=""):"U",SG=8&(CSG>7):"NA",SG=8&(CSG=""):"NA",1:CSGD) D KGF,SGF G EX
35 ;
36CSSG ;SET AJCC SUMMARY STAGE GROUP from CLINICAL STAGE GROUP (#38) FIELD
37 N SG,XD0
38 S XD0=DA
39 S PSG=$P($G(^ONCO(165.5,DA,2.1)),U,4),PSGD="" I PSG'="" S PSG=$E(PSG)
40 I PSG'="" S PSGD=$S(PSG=0:0,PSG=1:"I",PSG=2:"II",PSG=3:"III",PSG=4:"IV",PSG=9:"U",PSG=8:"NA",1:"")
41 I PSG'="",PSG<7 S SG=PSGD D KGF,SGF G EX
42 S SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9&(PSG'=8):"U",SG=8&(PSG'=9):"NA",1:PSGD) D KGF,SGF G EX
43 ;
44SSG ;SET AJCC SUMMARY STAGE GROUP from SUMMARY STAGE
45 N SG,XD0
46 S XD0=DA,SG=$E(X),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"") D KGF,SGF G EX
47 ;
48KGF ;KILL OLD AJCC-GP X-REFERENCE
49 N XSG
50 S XSG=$S($D(^ONCO(165.5,XD0,2)):$P(^(2),U,28),1:"") Q:XSG="" K ^ONCO(165.5,"ASG",XSG,DA) Q
51 ;
52SGF ;STUFF #38.5 AJCC SUMMARY STAGE-GROUP (2;28) and SET NEW CROSS REFERENCE
53 Q:SG="" S $P(^ONCO(165.5,XD0,2),U,28)=SG,^ONCO(165.5,"ASG",SG,DA)="" Q
54 ;
55KSG ;KILL STATEMENT F
56 S XD0=DA D KGF
57 I $D(DC) I DC="" D
58 .S SG=$S(DI=38:$P(^ONCO(165.5,XD0,2.1),U,4),DI=88:$P(^ONCO(165.5,XD0,2),U,20),1:""),SG=$E(SG),SG=$S(SG=0:0,SG=1:"I",SG=2:"II",SG=3:"III",SG=4:"IV",SG=9:"U",SG=8:"NA",1:"")
59 .S $P(^ONCO(165.5,XD0,2),U,28)=SG S:SG'="" ^ONCO(165.5,"ASG",SG,DA)="" Q
60 G EX
61EX ;KILL VARIABLES & EXIT
62 K CSG,CSGD,ONCOACL,PSG,PSGD,XAC,XY,XD0,XX,XCC,XSG Q
63SNHL ;Set SYSTEMIC SYMPTOMS (165.5,843) triggered from LYMPH NODES (165.5,31)
64 N ONCOS S ONCOS=$P($G(^ONCO(165.5,DA,0)),U,1) ;Site/Gp
65 N ONCOH S ONCOH=$$HIST^ONCFUNC(DA) ;Histology
66 ;If Lymphoma, set SYSTEMIC SYMPTOMS (165.5,843)
67 I $$LYMPHOMA^ONCFUNC(DA)!(ONCOS=62)!(ONCOS=63) D Q
68 .S $P(^ONCO(165.5,DA,"NHL1"),U,44)=$S(X=0:1,X=1!(X=2)!(X=3):2,X=9:9,1:"") Q
69 Q
70KNHL ;
71 Q
Note: See TracBrowser for help on using the repository browser.