ONCPL ;Hines OIFO/GWB - ONCOLOGY PROBLEM LIST ;07/14/04
;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
;
K ONCPL,PL
N DIR,DPTIEN,ICD,ONS,ONSDT,SAVEY,SUB,X
S SAVEY=Y
W !
W !," Would you like to see a PROBLEM LIST for this patient to assist"
W !," you in entering the COMORBIDITY/COMPLICATION #1-10"
W !," Secondary Diagnosis #1-10 prompts"
W !
S DIR(0)="Y",DIR("B")="Yes" D ^DIR
I (Y=0)!(Y="") W ! S Y=SAVEY Q
I Y[U S Y=SAVEY Q
I $P(^ONCO(160,D0,0),U,1)["LRT" W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
S DPTIEN=$P(^ONCO(160,D0,0),";",1)
;Supported by IA #928
D ACTIVE^GMPLUTL(DPTIEN,.ONCPL)
I ONCPL(0)=0 W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
S SUB=0 F S SUB=$O(ONCPL(SUB)) Q:SUB'>0 D
.S ONS=$P(ONCPL(SUB,3),U,1) S:ONS="" ONS="UNKNOWN"_SUB
.S PL(ONS)=$P(ONCPL(SUB,2),U,2)_U_$P(ONCPL(SUB,1),U,2)
I '$D(PL) W !!," No PROBLEM LIST for this patient." W ! S Y=SAVEY Q
W !
W !,"DATE OF ONSET"," ","ICD DIAGNOSIS"
W !,"------------- -------------------------------------------"
S ONS=0 F S ONS=$O(PL(ONS)) Q:ONS="" D
.I ONS["UNKNOWN" S ONSDT="UNKNOWN"
.I ONS'["UNKNOWN" S Y=ONS D DD^%DT S ONSDT=Y
.W !,ONSDT,?15,$P(PL(ONS),U,1),?24,$P(PL(ONS),U,2)
W !
S Y=SAVEY Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPL 1257 printed Apr 09, 2024@21:24:46 Page 2
ONCPL ;Hines OIFO/GWB - ONCOLOGY PROBLEM LIST ;07/14/04
+1 ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
+2 ;
+3 KILL ONCPL,PL
+4 NEW DIR,DPTIEN,ICD,ONS,ONSDT,SAVEY,SUB,X
+5 SET SAVEY=Y
+6 WRITE !
+7 WRITE !," Would you like to see a PROBLEM LIST for this patient to assist"
+8 WRITE !," you in entering the COMORBIDITY/COMPLICATION #1-10"
+9 WRITE !," Secondary Diagnosis #1-10 prompts"
+10 WRITE !
+11 SET DIR(0)="Y"
SET DIR("B")="Yes"
DO ^DIR
+12 IF (Y=0)!(Y="")
WRITE !
SET Y=SAVEY
QUIT
+13 IF Y[U
SET Y=SAVEY
QUIT
+14 IF $PIECE(^ONCO(160,D0,0),U,1)["LRT"
WRITE !!," No PROBLEM LIST for this patient."
WRITE !
SET Y=SAVEY
QUIT
+15 SET DPTIEN=$PIECE(^ONCO(160,D0,0),";",1)
+16 ;Supported by IA #928
+17 DO ACTIVE^GMPLUTL(DPTIEN,.ONCPL)
+18 IF ONCPL(0)=0
WRITE !!," No PROBLEM LIST for this patient."
WRITE !
SET Y=SAVEY
QUIT
+19 SET SUB=0
FOR
SET SUB=$ORDER(ONCPL(SUB))
if SUB'>0
QUIT
Begin DoDot:1
+20 SET ONS=$PIECE(ONCPL(SUB,3),U,1)
if ONS=""
SET ONS="UNKNOWN"_SUB
+21 SET PL(ONS)=$PIECE(ONCPL(SUB,2),U,2)_U_$PIECE(ONCPL(SUB,1),U,2)
End DoDot:1
+22 IF '$DATA(PL)
WRITE !!," No PROBLEM LIST for this patient."
WRITE !
SET Y=SAVEY
QUIT
+23 WRITE !
+24 WRITE !,"DATE OF ONSET"," ","ICD DIAGNOSIS"
+25 WRITE !,"------------- -------------------------------------------"
+26 SET ONS=0
FOR
SET ONS=$ORDER(PL(ONS))
if ONS=""
QUIT
Begin DoDot:1
+27 IF ONS["UNKNOWN"
SET ONSDT="UNKNOWN"
+28 IF ONS'["UNKNOWN"
SET Y=ONS
DO DD^%DT
SET ONSDT=Y
+29 WRITE !,ONSDT,?15,$PIECE(PL(ONS),U,1),?24,$PIECE(PL(ONS),U,2)
End DoDot:1
+30 WRITE !
+31 SET Y=SAVEY
QUIT
