ONCLPC1 ;Hines OIFO/GWB - 2001 Lung (NSCLC) Cancers PCE Study ;05/04/01
 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 ;Patient Information 
 S DIE="^ONCO(165.5,",DA=ONCONUM,DR=""
 W @IOF D HEAD^ONCLPC0
 W !," PATIENT INFORMATION"
 W !," -------------------"
 S DR(1,165.5,1)="1400.6  1. CO-MORBID CONDITIONS (YES/NO)."
 S DR(1,165.5,2)="I $G(X)=0 D CC1^ONCLPC1,CC2^ONCLPC1,CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 S DR(1,165.5,3)="1400      CO-MORBID CONDITION #1......."
 S DR(1,165.5,4)="I ($G(X)="""")&($P($G(^ONCO(165.5,DA,""LUN1"")),U,76)=1) D ITEM1ED^ONCLPC1 S Y=1400"
 S DR(1,165.5,5)="1400.1      CO-MORBID CONDITION #2......."
 S DR(1,165.5,6)="I $G(X)="""" D CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 S DR(1,165.5,7)="1400.2      CO-MORBID CONDITION #3......."
 S DR(1,165.5,8)="I $G(X)="""" D CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 S DR(1,165.5,9)="1400.3      CO-MORBID CONDITION #4......."
 S DR(1,165.5,10)="I $G(X)="""" D CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 S DR(1,165.5,11)="1400.4      CO-MORBID CONDITION #5......."
 S DR(1,165.5,12)="I $G(X)="""" D CC6^ONCLPC1 S Y=1401"
 S DR(1,165.5,13)="1400.5      CO-MORBID CONDITION #6......."
 S DR(1,165.5,14)="W !"
 S DR(1,165.5,15)="1401  2. DURATION OF TOBACCO USE......."
 S DR(1,165.5,16)="W !"
 S DR(1,165.5,17)="S DEF="""" D ITEM3^ONCLPC1 K DEF"
 S DR(1,165.5,18)="1403  3. PERSONAL HISTORY OF OTHER                                                        INVASIVE MALIGNANCIES PRIOR                                                      TO THIS CANCER DIAGNOSIS....//^S X=PHDEF"
 D ^DIE
 W !
 K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
EXIT K DIC,DR,DA,DIQ,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 Q
ITEM1ED ;ITEM 1 EDIT
 W !
 W !,"     CO-MORBID CONDITIONS (YES/NO) equals ""Yes"""
 W !,"      CO-MORBID CONDITION #1 may not be blank"
 W !
 Q 
CC1 S $P(^ONCO(165.5,D0,"LUN1"),U,1)=""
 W !,"      CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
 Q
CC2 S $P(^ONCO(165.5,D0,"LUN1"),U,2)=""
 W !,"      CO-MORBID CONDITION #2.......:"
 Q
CC3 S $P(^ONCO(165.5,D0,"LUN1"),U,3)=""
 W !,"      CO-MORBID CONDITION #3.......:"
 Q
CC4 S $P(^ONCO(165.5,D0,"LUN1"),U,4)=""
 W !,"      CO-MORBID CONDITION #4.......:"
 Q
CC5 S $P(^ONCO(165.5,D0,"LUN1"),U,5)=""
 W !,"      CO-MORBID CONDITION #5.......:"
 Q
CC6 S $P(^ONCO(165.5,D0,"LUN1"),U,6)=""
 W !,"      CO-MORBID CONDITION #6.......:"
 W !
 Q
ITEM3 ;PERSONAL HISTORY OF OTHER INVASIVE MALIGNANCIES PRIOR TO THIS CANCER
 ;DIAGNOSIS and Item 8 of the 2001 Gastric Cancers PCE Study
 ;(165.5,1403) and (165.5,1573)
 ;XECUTABLE 'HELP'
 N PHOM,PATIEN,PRIMIEN,PHOMDTXI,PHOMDTXE,PHOMTOP,PNUM,PHDTDX,PHLAST
 S PATIEN=$P(^ONCO(165.5,D0,0),U,2),PRIMIEN=""
 F  S PRIMIEN=$O(^ONCO(165.5,"C",PATIEN,PRIMIEN)) Q:PRIMIEN'>0  I $P($G(^ONCO(165.5,PRIMIEN,"DIV")),U,1)=DUZ(2) D
 .Q:PRIMIEN=D0
 .S PHODTXI=$$GET1^DIQ(165.5,PRIMIEN,3,"I")
 .S PHODTXE=$$GET1^DIQ(165.5,PRIMIEN,3,"E")
 .S PHOMTOP=$$GET1^DIQ(165.5,PRIMIEN,20.1)
 .Q:(PHODTXI="")!(PHOMTOP="")
 .S PHOM(PHODTXI)=PHODTXE_U_PHOMTOP
 I $D(DEF) D  Q
 .I '$D(PHOM) S PHDEF="C88.8" Q
 .S PHDTDX="",PHLAST=$O(PHOM(PHDTDX),-1),PHDEF=$P(PHOM(PHLAST),U,2) Q
 W !?3,"This item describes the patient's prior history of other invasive"
 W !?3,"malignancies.  If the patient has a history of other malignancies"
 W !?3,"report the ICD-O-3 site code for the most recently diagnosed disease."
 W !?3,"If the patient has no personal history of other cancer, code C88.8. If"
 W !?3,"the patient's personal history of other invasive malignancies is not"
 W !?3,"documented, code C99.9."
 W !
 W !?3,"Allowable Codes: C00.0 thru C80.9 - valid ICD-0-3 site (topography) codes"
 W !?3,"                 C88.8 - no personal history of other cancer"
 W !?3,"                 C99.9 - personal history of other cancer not documented"
 W !
 I '$D(PHOM) W !?3,"This patient has no other primaries." G ITEM3EX
 W !?3,"Other primaries for this patient:",!
 W !?3,"Date DX"
 W !?3,"-----------------"
 S PNUM="" F  S PNUM=$O(PHOM(PNUM)) Q:PNUM'>0  D
 .W !?3,$P(PHOM(PNUM),U,1),?15,$P(PHOM(PNUM),U,2)
ITEM3EX W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCLPC1   4222     printed  Sep 23, 2025@19:59:39                                                                                                                                                                                                     Page 2
ONCLPC1   ;Hines OIFO/GWB - 2001 Lung (NSCLC) Cancers PCE Study ;05/04/01
 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 +2       ;Patient Information 
 +3        SET DIE="^ONCO(165.5,"
           SET DA=ONCONUM
           SET DR=""
 +4        WRITE @IOF
           DO HEAD^ONCLPC0
 +5        WRITE !," PATIENT INFORMATION"
 +6        WRITE !," -------------------"
 +7        SET DR(1,165.5,1)="1400.6  1. CO-MORBID CONDITIONS (YES/NO)."
 +8        SET DR(1,165.5,2)="I $G(X)=0 D CC1^ONCLPC1,CC2^ONCLPC1,CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 +9        SET DR(1,165.5,3)="1400      CO-MORBID CONDITION #1......."
 +10       SET DR(1,165.5,4)="I ($G(X)="""")&($P($G(^ONCO(165.5,DA,""LUN1"")),U,76)=1) D ITEM1ED^ONCLPC1 S Y=1400"
 +11       SET DR(1,165.5,5)="1400.1      CO-MORBID CONDITION #2......."
 +12       SET DR(1,165.5,6)="I $G(X)="""" D CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 +13       SET DR(1,165.5,7)="1400.2      CO-MORBID CONDITION #3......."
 +14       SET DR(1,165.5,8)="I $G(X)="""" D CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 +15       SET DR(1,165.5,9)="1400.3      CO-MORBID CONDITION #4......."
 +16       SET DR(1,165.5,10)="I $G(X)="""" D CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
 +17       SET DR(1,165.5,11)="1400.4      CO-MORBID CONDITION #5......."
 +18       SET DR(1,165.5,12)="I $G(X)="""" D CC6^ONCLPC1 S Y=1401"
 +19       SET DR(1,165.5,13)="1400.5      CO-MORBID CONDITION #6......."
 +20       SET DR(1,165.5,14)="W !"
 +21       SET DR(1,165.5,15)="1401  2. DURATION OF TOBACCO USE......."
 +22       SET DR(1,165.5,16)="W !"
 +23       SET DR(1,165.5,17)="S DEF="""" D ITEM3^ONCLPC1 K DEF"
 +24       SET DR(1,165.5,18)="1403  3. PERSONAL HISTORY OF OTHER                                                        INVASIVE MALIGNANCIES PRIOR                                                      TO THIS CANCER DIAGNOSIS....//^S X=PHDEF"
 +25       DO ^DIE
 +26       WRITE !
 +27       KILL DIR
           SET DIR(0)="E"
           DO ^DIR
           if $DATA(DIRUT)
               SET OUT="Y"
EXIT       KILL DIC,DR,DA,DIQ,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 +1        QUIT 
ITEM1ED   ;ITEM 1 EDIT
 +1        WRITE !
 +2        WRITE !,"     CO-MORBID CONDITIONS (YES/NO) equals ""Yes"""
 +3        WRITE !,"      CO-MORBID CONDITION #1 may not be blank"
 +4        WRITE !
 +5        QUIT 
CC1        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,1)=""
 +1        WRITE !,"      CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
 +2        QUIT 
CC2        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,2)=""
 +1        WRITE !,"      CO-MORBID CONDITION #2.......:"
 +2        QUIT 
CC3        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,3)=""
 +1        WRITE !,"      CO-MORBID CONDITION #3.......:"
 +2        QUIT 
CC4        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,4)=""
 +1        WRITE !,"      CO-MORBID CONDITION #4.......:"
 +2        QUIT 
CC5        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,5)=""
 +1        WRITE !,"      CO-MORBID CONDITION #5.......:"
 +2        QUIT 
CC6        SET $PIECE(^ONCO(165.5,D0,"LUN1"),U,6)=""
 +1        WRITE !,"      CO-MORBID CONDITION #6.......:"
 +2        WRITE !
 +3        QUIT 
ITEM3     ;PERSONAL HISTORY OF OTHER INVASIVE MALIGNANCIES PRIOR TO THIS CANCER
 +1       ;DIAGNOSIS and Item 8 of the 2001 Gastric Cancers PCE Study
 +2       ;(165.5,1403) and (165.5,1573)
 +3       ;XECUTABLE 'HELP'
 +4        NEW PHOM,PATIEN,PRIMIEN,PHOMDTXI,PHOMDTXE,PHOMTOP,PNUM,PHDTDX,PHLAST
 +5        SET PATIEN=$PIECE(^ONCO(165.5,D0,0),U,2)
           SET PRIMIEN=""
 +6        FOR 
               SET PRIMIEN=$ORDER(^ONCO(165.5,"C",PATIEN,PRIMIEN))
               if PRIMIEN'>0
                   QUIT 
               IF $PIECE($GET(^ONCO(165.5,PRIMIEN,"DIV")),U,1)=DUZ(2)
                   Begin DoDot:1
 +7                    if PRIMIEN=D0
                           QUIT 
 +8                    SET PHODTXI=$$GET1^DIQ(165.5,PRIMIEN,3,"I")
 +9                    SET PHODTXE=$$GET1^DIQ(165.5,PRIMIEN,3,"E")
 +10                   SET PHOMTOP=$$GET1^DIQ(165.5,PRIMIEN,20.1)
 +11                   if (PHODTXI="")!(PHOMTOP="")
                           QUIT 
 +12                   SET PHOM(PHODTXI)=PHODTXE_U_PHOMTOP
                   End DoDot:1
 +13       IF $DATA(DEF)
               Begin DoDot:1
 +14               IF '$DATA(PHOM)
                       SET PHDEF="C88.8"
                       QUIT 
 +15               SET PHDTDX=""
                   SET PHLAST=$ORDER(PHOM(PHDTDX),-1)
                   SET PHDEF=$PIECE(PHOM(PHLAST),U,2)
                   QUIT 
               End DoDot:1
               QUIT 
 +16       WRITE !?3,"This item describes the patient's prior history of other invasive"
 +17       WRITE !?3,"malignancies.  If the patient has a history of other malignancies"
 +18       WRITE !?3,"report the ICD-O-3 site code for the most recently diagnosed disease."
 +19       WRITE !?3,"If the patient has no personal history of other cancer, code C88.8. If"
 +20       WRITE !?3,"the patient's personal history of other invasive malignancies is not"
 +21       WRITE !?3,"documented, code C99.9."
 +22       WRITE !
 +23       WRITE !?3,"Allowable Codes: C00.0 thru C80.9 - valid ICD-0-3 site (topography) codes"
 +24       WRITE !?3,"                 C88.8 - no personal history of other cancer"
 +25       WRITE !?3,"                 C99.9 - personal history of other cancer not documented"
 +26       WRITE !
 +27       IF '$DATA(PHOM)
               WRITE !?3,"This patient has no other primaries."
               GOTO ITEM3EX
 +28       WRITE !?3,"Other primaries for this patient:",!
 +29       WRITE !?3,"Date DX"
 +30       WRITE !?3,"-----------------"
 +31       SET PNUM=""
           FOR 
               SET PNUM=$ORDER(PHOM(PNUM))
               if PNUM'>0
                   QUIT 
               Begin DoDot:1
 +32               WRITE !?3,$PIECE(PHOM(PNUM),U,1),?15,$PIECE(PHOM(PNUM),U,2)
               End DoDot:1
ITEM3EX    WRITE !
           KILL DIR
           SET DIR(0)="E"
           DO ^DIR
           if $DATA(DIRUT)
               SET OUT="Y"
 +1        QUIT