- 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 Feb 18, 2025@23:53:36 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
