source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCPL.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: 1.1 KB
RevLine 
[613]1ONCPL ;Hines OIFO/GWB - ONCOLOGY PROBLEM LIST ;07/14/04
2 ;;2.11;ONCOLOGY;**41,42,45**;Mar 07, 1995
3 ;
4 S SAVEY=Y
5 K ONCPL,PL N DIR,X
6 W !
7 W !," Would you like to see a PROBLEM LIST for this patient to assist"
8 S DIR("A")=" you in entering the COMORBIDITY/COMPLICATION #1-10 prompts"
9 S DIR(0)="Y",DIR("B")="Yes" D ^DIR
10 I (Y=0)!(Y="") W ! S Y=SAVEY Q
11 I Y[U S Y=SAVEY Q
12 I $P(^ONCO(160,D0,0),U,1)["LRT" W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
13 S DPTIEN=$P(^ONCO(160,D0,0),";",1)
14 D ACTIVE^GMPLUTL(DPTIEN,.ONCPL)
15 I ONCPL(0)=0 W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
16 S SUB=0 F S SUB=$O(ONCPL(SUB)) Q:SUB'>0 D
17 .S ICD=$G(^ICD9($P(ONCPL(SUB,2),U,1),0)) Q:ICD=""
18 .S ONS=$P(ONCPL(SUB,3),U,1) S:ONS="" ONS="UNKNOWN"_SUB
19 .S PL(ONS)=ICD
20 I '$D(PL) W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
21 W !
22 W !,"DATE OF ONSET"," ","ICD DIAGNOSIS"
23 W !,"------------- -------------------------------------------"
24 S ONS=0 F S ONS=$O(PL(ONS)) Q:ONS="" D
25 .I ONS["UNKNOWN" S ONSDT="UNKNOWN"
26 .I ONS'["UNKNOWN" S Y=ONS D DD^%DT S ONSDT=Y
27 .W !,ONSDT,?15,$P(PL(ONS),U,1),?24,$P(PL(ONS),U,3)
28 W !
29 S Y=SAVEY Q
Note: See TracBrowser for help on using the repository browser.