source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCPST11.m@ 1036

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

initial load of WorldVistAEHR

File size: 967 bytes
RevLine 
[613]1ONCPST11 ;HIRMFO/GWB - Post-init for Patch ONC*2.11*11;5/21/97
2 ;;2.11;ONCOLOGY;**11**; Mar 07, 1995
3 ;Restage RECTUM/ANUS/CANAL OVERLAP (C21.0)
4 ; CERVIX, ENDOCERVIX (C53.0)
5 ; SINUS, ACCESSORY OVERLAP (C31.8)
6 ;DATE DX (#165.5, #3) must be > 12/31/91.
7 W !,"Restaging primaries with an ICD0-TOPOGRAPHY of C21.0, C53.0 or C31.8 and a"
8 W !,"DATE DX > 12/31/91.",!
9 S IEN=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
10 .S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16) Q:DATEDX<2920101
11 .S TOPIEN=$P($G(^ONCO(165.5,IEN,2)),U,1) Q:TOPIEN=""
12 .S TOPCOD=$P($G(^ONCO(164,TOPIEN,0)),U,2)
13 .I (TOPCOD="C21.8")!(TOPCOD="C31.8")!(TOPCOD="C53.0") D
14 ..S SITE=$$GET1^DIQ(165.5,IEN,.01)
15 ..S PT=$$GET1^DIQ(165.5,IEN,.02)
16 ..W !,"Restaging ",SITE," primary for patient ",PT," ..."
17 ..S (DA,D0)=IEN
18 ..S STGIND="C" D ES^ONCOTN
19 ..S STGIND="P" D ES^ONCOTN
20 ..W "******************************************************************"
21 K IEN,DATEDX,TOPIEN,TOPCOD,SITE,PT Q
Note: See TracBrowser for help on using the repository browser.