source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP2P0.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1ONCP2P0 ;HINES CIOFO/GWB - PROSTATE PCE 1998 ;6/1/98
2 ;;2.11;ONCOLOGY;**18**;Mar 07, 1995
3CHECK ;Check PCE eligibility
4 ;Check if ACCESSION YEAR = 1998
5 I $P(^ONCO(165.5,ONCONUM,0),U,7)'=1998 S MSG="The Accession Year is not 1998." D ERRMSG G EXIT
6 ;Check if histologically confirmed
7 S DC=$P($G(^ONCO(165.5,ONCONUM,2)),U,6) I DC'=1 S MSG="The Diagnostic Confirmation code is not 1 (Positive histology)." D ERRMSG G EXIT
8 ;Check if Class of Case is either 1, 2 or 6.
9 S COC=$P($G(^ONCO(165.5,ONCONUM,0)),U,4) I (COC'=1)&(COC'=2)&(COC'=6) S MSG="The Class of Case code is not 1, 2 or 6." D ERRMSG G EXIT
10MENU ;Prostate PCE menu
11 S $P(^ONCO(165.5,ONCONUM,7),U,15)="PRO2"
12 S ^ONCO(165.5,"APCE","PRO2",ONCONUM)=""
13 K DIR D HEAD
14 S DIR(0)="SO^1:General Information;2:Initial Diagnosis;3:Extent and Stage of Disease;4:First Course of Treatment;5:First Recurrence;6:Status at Last Contact;7:All;8:Print Prostate PCE"
15 S DIR("A")="Select Table" D ^DIR
16 G:$D(DIRUT)!($D(DIROUT)) EXIT
17 I Y=7 S OUT="" D G MENU
18 .D ^ONCP2P1 Q:$G(OUT)="Y"
19 .D ^ONCP2P2 Q:$G(OUT)="Y"
20 .D ^ONCP2P3 Q:$G(OUT)="Y"
21 .D ^ONCP2P4 Q:$G(OUT)="Y"
22 .D ^ONCP2P5 Q:$G(OUT)="Y"
23 .D ^ONCP2P6 Q:$G(OUT)="Y"
24 S SUB="^ONCP2P"_Y D @SUB G MENU
25ERRMSG ;Error message
26 I ONCOANS=5 W !!,?10,"This primary does not satisfy the PCE eligibility criteria:",!,?10,MSG R Z:10
27 K MSG Q
28HEAD ;PCE HEADER
29 W @IOF,!,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
30 S HDL=$L(" 1998 Patient Care Evaluation Study of Prostate Cancer"),TAB=(80-HDL)\2,TAB=TAB-1
31 W !,?TAB,"1998 Patient Care Evaluation Study of Prostate Cancer",!,DASHES
32 Q
33EXIT ;Kill Variables and Exit.
34 K HDL,ONCONUM,ONCOPA,OUT,SUB,TAB
35 K DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
36 Q
Note: See TracBrowser for help on using the repository browser.