source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCHPC0.m@ 1361

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1ONCHPC0 ;Hines OIFO/GWB - 2000 HEPATOCELLULAR CANCERS PCE STUDY ;01/06/00
2 ;;2.11;ONCOLOGY;**26**;Mar 07, 1995
3 ;Check PCE eligibility
4 ;
5 ;ACCESSION YEAR (165.5,.07) = 2000
6 I $P(^ONCO(165.5,ONCONUM,0),U,7)'=2000 S MSG="The Accession Year is not 2000." D ERRMSG G EXIT
7 ;
8 ;DIAGNOSTIC CONFIRMATION (165.5,26) = 1, 2, 4 or 5
9 S DC=$P($G(^ONCO(165.5,ONCONUM,2)),U,6)
10 I (DC'=1)&(DC'=2)&(DC'=4)&(DC'=5) S MSG="The Diagnostic Confirmation code is not 1, 2, 4 or 5." D ERRMSG G EXIT
11 ;
12 ;CLASS OF CASE (165.5,.04) = 0, 1 or 2
13 S COC=$P($G(^ONCO(165.5,ONCONUM,0)),U,4)
14 I (COC'=0)&(COC'=1)&(COC'=2) S MSG="The Class of Case code is not 0, 1 or 2." D ERRMSG G EXIT
15 ;
16 ;BEHAVIOR = 3.
17 I BEH'=3 S MSG="The Behavior Code is not 3 (Malignant)." D ERRMSG G EXIT
18 ;
19 ;HISTOLOGY (165.5,22)
20 S HST(80103)=""
21 S HST(81403)=""
22 S HST(81603)=""
23 S HST(81613)=""
24 S HST(81703)=""
25 S HST(81713)=""
26 S HST(81803)=""
27 S HST(84403)=""
28 S HST(88003)=""
29 S HST(88103)=""
30 S HST(88143)=""
31 S HST(88503)=""
32 S HST(88513)=""
33 S HST(88523)=""
34 S HST(88533)=""
35 S HST(88543)=""
36 S HST(88553)=""
37 S HST(88583)=""
38 S HST(89703)=""
39 S HST(89913)=""
40 S HST(91203)=""
41 S HST(91333)=""
42 I $D(HST(HIST)) G MENU
43 I (HIST>95902)&(HIST<97174) G MENU
44 E S MSG="Invalid Histology code." D ERRMSG G EXIT
45 ;
46MENU ;Hepatocellular Cancers PCE menu
47 K HST
48 S $P(^ONCO(165.5,ONCONUM,7),U,15)="HEP"
49 S ^ONCO(165.5,"APCE","HEP",ONCONUM)=""
50 K DIR D HEAD
51 S DIR(0)="SO^1:Patient Information;2:Tumor Identification;3:Stage of Disease at Diagnosis;4:First Course of Treatment;5:Recurrence;6:Follow-Up;7:All;8:Print Hepatocellular PCE"
52 S DIR("A")="Select section" D ^DIR
53 G:$D(DIRUT)!($D(DIROUT)) EXIT
54 I Y=7 S OUT="" D G MENU
55 .D ^ONCHPC1 Q:$G(OUT)="Y"
56 .D ^ONCHPC2 Q:$G(OUT)="Y"
57 .D ^ONCHPC3 Q:$G(OUT)="Y"
58 .D ^ONCHPC4 Q:$G(OUT)="Y"
59 .D ^ONCHPC5 Q:$G(OUT)="Y"
60 .D ^ONCHPC6 Q:$G(OUT)="Y"
61 S SUB="^ONCHPC"_Y D @SUB G MENU
62 ;
63ERRMSG ;Error message
64 I ONCOANS=5 W !!,?8,"This primary does not satisfy the PCE eligibility criteria:",!!,?8,MSG R Z:10
65 K MSG Q
66 ;
67HEAD ;PCE header
68 W @IOF,!,?1,PATNAM,?SITTAB,SITEGP
69 W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
70 W !,DASHES
71 S HDL=$L("2000 Patient Care Evaluation Study of Hepatocellular Cancers")
72 S TAB=(80-HDL)\2,TAB=TAB-1
73 W !,?TAB,"2000 Patient Care Evaluation Study of Hepatocellular Cancers"
74 W !,DASHES
75 Q
76 ;
77EXIT ;Kill variables and exit
78 K HDL,ONCONUM,ONCOPA,OUT,SUB,TAB,HST
79 K DIC,DIR,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,X,Y
80 Q
Note: See TracBrowser for help on using the repository browser.