ONCGPC7 ;Hines OIFO/GWB - 2001 Gastric Cancers PCE Study ;04/16/01
 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 ;Print 
 K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KILL
 I $D(IO("Q")) S ONCOLST="ONCONUM^ONCOPA^PATNAM^SPACES^TOPNAM^SSN^TOPTAB^TOPCOD^DASHES^SITTAB^SITEGP^ADENOCA^HIST1234^LYMPHOMA" D TASK G KILL
 U IO D PRT D ^%ZISC K %ZIS,IOP G KILL
PRT S EX="",LIN=$S(IOST?1"C".E:IOSL-2,1:IOSL-4),IE=ONCONUM
 S HIST=$$HIST^ONCFUNC(ONCONUM)
 S HIST1234=$E(HIST,1,4),BEH=$E(HIST,5)
 S ADENOCA=0,LYMPHOMA=0
 I (HIST1234>8139)&(HIST1234<8577) S ADENOCA=1  ;Adenocarcinomas
 I HIST1234=8941 S ADENOCA=1                    ;Adenocarcinoma
 I (HIST1234>9589)&(HIST1234<9730) S LYMPHOMA=1 ;Lymphomas
 S CMC=$$GET1^DIQ(165.5,IE,1400.6) ;GAS CO-MORBID CONDITIONS Y/N
 S TC=$$GET1^DIQ(165.5,IE,1426.5)  ;LNG COMPLICATIONS Y/N
 K LINE S $P(LINE,"-",40)="-"
I S TABLE="PATIENT INFORMATION"
 D HEAD^ONCGPC0
 K LINE S $P(LINE,"-",19)="-"
 W !?4,TABLE,!?4,LINE
ITEM1 W !," 1. CO-MORBID CONDITIONS:"
 D P Q:EX=U
 I CMC="No" D  G CMC2
 .W !,"     CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
 W !,"     CO-MORBID CONDITION #1.......: ",$P($$GET1^DIQ(165.5,IE,1571)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571)," ",2,99)
CMC2 D P Q:EX=U
 W !,"     CO-MORBID CONDITION #2.......: ",$P($$GET1^DIQ(165.5,IE,1571.1)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.1)," ",2,99)
 D P Q:EX=U
 W !,"     CO-MORBID CONDITION #3.......: ",$P($$GET1^DIQ(165.5,IE,1571.2)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.2)," ",2,99)
 D P Q:EX=U
 W !,"     CO-MORBID CONDITION #4.......: ",$P($$GET1^DIQ(165.5,IE,1571.3)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.3)," ",2,99)
 D P Q:EX=U
 W !,"     CO-MORBID CONDITION #5.......: ",$P($$GET1^DIQ(165.5,IE,1571.4)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.4)," ",2,99)
 D P Q:EX=U
 W !,"     CO-MORBID CONDITION #6.......: ",$P($$GET1^DIQ(165.5,IE,1571.5)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.5)," ",2,99)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM2 W !," 2. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,1500)
 W !
 D P Q:EX=U
ITEM3 W !," 3. ALCOHOL CONSUMPTION...........: ",$$GET1^DIQ(165.5,IE,1501)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM4 W !," 4. DURATION OF TOBACCO USE.......: ",$$GET1^DIQ(165.5,IE,1572)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM5 W !," 5. MENOPAUSAL STATUS AND HORMONE"
 D P Q:EX=U
 W !,"     REPLACEMENT THERAPY..........: ",$$GET1^DIQ(165.5,IE,1502)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM6 W !," 6. H2/BLOCKER PROTON PUMP"
 D P Q:EX=U
 W !,"     INHIBITOR....................: ",$$GET1^DIQ(165.5,IE,1503)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM7 W !," 7. FAMILY HISTORY OF GASTRIC"
 D P Q:EX=U
 W !,"     CANCER.......................: ",$$GET1^DIQ(165.5,IE,1504)
 W !
 D P Q:EX=U
ITEM8 W !," 8. PERSONAL HISTORY OF OTHER"
 D P Q:EX=U
 W !,"     INVASIVE MALIGNANCIES PRIOR"
 D P Q:EX=U
 W !,"      TO THIS CANCER DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,1573)
 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y  D HEAD^ONCGPC0 G ITEM9
 W !
 D P Q:EX=U
ITEM9 W !," 9. ASSOCIATED BENIGN CONDITIONS:"
 D P Q:EX=U
 W !,"     H-PYLORI INECTION............: ",$$GET1^DIQ(165.5,IE,1505)
 D P Q:EX=U
 W !,"     DUODENAL ULCER...............: ",$$GET1^DIQ(165.5,IE,1506)
 D P Q:EX=U
 W !,"     GASTRIC ULCER................: ",$$GET1^DIQ(165.5,IE,1507)
 D P Q:EX=U
 W !,"     HEARTBURN....................: ",$$GET1^DIQ(165.5,IE,1508)
 D P Q:EX=U
 W !,"     PERNICIOUS ANEMIA............: ",$$GET1^DIQ(165.5,IE,1509)
 D P Q:EX=U
 W !,"     POLYPS OF STOMACH............: ",$$GET1^DIQ(165.5,IE,1510)
 D P Q:EX=U
 W !,"     POLYPOSIS OF SMALL OR LARGE"
 D P Q:EX=U
 W !,"      BOWEL.......................: ",$$GET1^DIQ(165.5,IE,1511)
 D P Q:EX=U
 W !,"     BARRETT'S ESOPHAGUS..........: ",$$GET1^DIQ(165.5,IE,1512)
 D P Q:EX=U
 W !,"     ATROPHIC GASTRITIS...........: ",$$GET1^DIQ(165.5,IE,1513)
 D P Q:EX=U
 W !,"     GASTRIC METAPLASIA...........: ",$$GET1^DIQ(165.5,IE,1514)
 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y  D HEAD^ONCGPC0 G ITEM10
 W !
 D P Q:EX=U
ITEM10 W !,"10. H-PYLORI DRUGS GIVEN:"
 D P Q:EX=U
 W !,"     ANTIBIOTICS..................: ",$$GET1^DIQ(165.5,IE,1515)
 D P Q:EX=U
 W !,"     PROTON PUMP INHIBITORS.......: ",$$GET1^DIQ(165.5,IE,1516)
 D P Q:EX=U
 W !,"     H2 BLOCKERS..................: ",$$GET1^DIQ(165.5,IE,1517)
 D P Q:EX=U
 W !,"     BISMUTH COMPOUNDS............: ",$$GET1^DIQ(165.5,IE,1518)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM11 W !,"11. PRIOR INTRA-ABDOMINAL SURGERY.: ",$$GET1^DIQ(165.5,IE,1519)
 D P Q:EX=U
 W !
 D P Q:EX=U
ITEM12 W !,"12. YEAR OF PRIOR GASTRIC"
 D P Q:EX=U
 W !,"     RESECTION....................: ",$$GET1^DIQ(165.5,IE,1520)
 D P Q:EX=U
 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y
 I IOST?1"C".E D HEAD^ONCGPC0
 D ^ONCGPC7A
KILL ;
 K CS,CSDAT,CSI,CSPNT,DESC,DESC1,DESC2,DLC,DOFCT
 K EX,IE,LIN,LINE,LOS,NOP,ONCOLST,TABLE
 K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 Q
P ;Print
 I ($Y'<(LIN-1)) D  Q:EX=U
 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
 .D HEAD^ONCGPC0 Q
 Q
TASK ;Queue a task
 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
 S ZTRTN="PRT^ONCGPC7",ZTREQ="@",ZTSAVE("ZTREQ")=""
 S ZTDESC="Print Gastric Cancers PCE"
 F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1=""  S ZTSAVE(V1)=""
 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
 K V1,V2,ONCOLST,ZTSK Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCGPC7   5369     printed  Sep 23, 2025@19:59:07                                                                                                                                                                                                     Page 2
ONCGPC7   ;Hines OIFO/GWB - 2001 Gastric Cancers PCE Study ;04/16/01
 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
 +2       ;Print 
 +3        KILL IOP,%ZIS
           SET %ZIS="MQ"
           WRITE !
           DO ^%ZIS
           KILL %ZIS,IOP
           if POP
               GOTO KILL
 +4        IF $DATA(IO("Q"))
               SET ONCOLST="ONCONUM^ONCOPA^PATNAM^SPACES^TOPNAM^SSN^TOPTAB^TOPCOD^DASHES^SITTAB^SITEGP^ADENOCA^HIST1234^LYMPHOMA"
               DO TASK
               GOTO KILL
 +5        USE IO
           DO PRT
           DO ^%ZISC
           KILL %ZIS,IOP
           GOTO KILL
PRT        SET EX=""
           SET LIN=$SELECT(IOST?1"C".E:IOSL-2,1:IOSL-4)
           SET IE=ONCONUM
 +1        SET HIST=$$HIST^ONCFUNC(ONCONUM)
 +2        SET HIST1234=$EXTRACT(HIST,1,4)
           SET BEH=$EXTRACT(HIST,5)
 +3        SET ADENOCA=0
           SET LYMPHOMA=0
 +4       ;Adenocarcinomas
           IF (HIST1234>8139)&(HIST1234<8577)
               SET ADENOCA=1
 +5       ;Adenocarcinoma
           IF HIST1234=8941
               SET ADENOCA=1
 +6       ;Lymphomas
           IF (HIST1234>9589)&(HIST1234<9730)
               SET LYMPHOMA=1
 +7       ;GAS CO-MORBID CONDITIONS Y/N
           SET CMC=$$GET1^DIQ(165.5,IE,1400.6)
 +8       ;LNG COMPLICATIONS Y/N
           SET TC=$$GET1^DIQ(165.5,IE,1426.5)
 +9        KILL LINE
           SET $PIECE(LINE,"-",40)="-"
I          SET TABLE="PATIENT INFORMATION"
 +1        DO HEAD^ONCGPC0
 +2        KILL LINE
           SET $PIECE(LINE,"-",19)="-"
 +3        WRITE !?4,TABLE,!?4,LINE
ITEM1      WRITE !," 1. CO-MORBID CONDITIONS:"
 +1        DO P
           if EX=U
               QUIT 
 +2        IF CMC="No"
               Begin DoDot:1
 +3                WRITE !,"     CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
               End DoDot:1
               GOTO CMC2
 +4        WRITE !,"     CO-MORBID CONDITION #1.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571)," ",2,99)
CMC2       DO P
           if EX=U
               QUIT 
 +1        WRITE !,"     CO-MORBID CONDITION #2.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571.1)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571.1)," ",2,99)
 +2        DO P
           if EX=U
               QUIT 
 +3        WRITE !,"     CO-MORBID CONDITION #3.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571.2)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571.2)," ",2,99)
 +4        DO P
           if EX=U
               QUIT 
 +5        WRITE !,"     CO-MORBID CONDITION #4.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571.3)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571.3)," ",2,99)
 +6        DO P
           if EX=U
               QUIT 
 +7        WRITE !,"     CO-MORBID CONDITION #5.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571.4)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571.4)," ",2,99)
 +8        DO P
           if EX=U
               QUIT 
 +9        WRITE !,"     CO-MORBID CONDITION #6.......: ",$PIECE($$GET1^DIQ(165.5,IE,1571.5)," ",1),?43,$PIECE($$GET1^DIQ(165.5,IE,1571.5)," ",2,99)
 +10       DO P
           if EX=U
               QUIT 
 +11       WRITE !
 +12       DO P
           if EX=U
               QUIT 
ITEM2      WRITE !," 2. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,1500)
 +1        WRITE !
 +2        DO P
           if EX=U
               QUIT 
ITEM3      WRITE !," 3. ALCOHOL CONSUMPTION...........: ",$$GET1^DIQ(165.5,IE,1501)
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !
 +3        DO P
           if EX=U
               QUIT 
ITEM4      WRITE !," 4. DURATION OF TOBACCO USE.......: ",$$GET1^DIQ(165.5,IE,1572)
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !
 +3        DO P
           if EX=U
               QUIT 
ITEM5      WRITE !," 5. MENOPAUSAL STATUS AND HORMONE"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     REPLACEMENT THERAPY..........: ",$$GET1^DIQ(165.5,IE,1502)
 +3        DO P
           if EX=U
               QUIT 
 +4        WRITE !
 +5        DO P
           if EX=U
               QUIT 
ITEM6      WRITE !," 6. H2/BLOCKER PROTON PUMP"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     INHIBITOR....................: ",$$GET1^DIQ(165.5,IE,1503)
 +3        DO P
           if EX=U
               QUIT 
 +4        WRITE !
 +5        DO P
           if EX=U
               QUIT 
ITEM7      WRITE !," 7. FAMILY HISTORY OF GASTRIC"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     CANCER.......................: ",$$GET1^DIQ(165.5,IE,1504)
 +3        WRITE !
 +4        DO P
           if EX=U
               QUIT 
ITEM8      WRITE !," 8. PERSONAL HISTORY OF OTHER"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     INVASIVE MALIGNANCIES PRIOR"
 +3        DO P
           if EX=U
               QUIT 
 +4        WRITE !,"      TO THIS CANCER DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,1573)
 +5        IF IOST?1"C".E
               WRITE !
               KILL DIR
               SET DIR(0)="E"
               DO ^DIR
               if 'Y
                   QUIT 
               DO HEAD^ONCGPC0
               GOTO ITEM9
 +6        WRITE !
 +7        DO P
           if EX=U
               QUIT 
ITEM9      WRITE !," 9. ASSOCIATED BENIGN CONDITIONS:"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     H-PYLORI INECTION............: ",$$GET1^DIQ(165.5,IE,1505)
 +3        DO P
           if EX=U
               QUIT 
 +4        WRITE !,"     DUODENAL ULCER...............: ",$$GET1^DIQ(165.5,IE,1506)
 +5        DO P
           if EX=U
               QUIT 
 +6        WRITE !,"     GASTRIC ULCER................: ",$$GET1^DIQ(165.5,IE,1507)
 +7        DO P
           if EX=U
               QUIT 
 +8        WRITE !,"     HEARTBURN....................: ",$$GET1^DIQ(165.5,IE,1508)
 +9        DO P
           if EX=U
               QUIT 
 +10       WRITE !,"     PERNICIOUS ANEMIA............: ",$$GET1^DIQ(165.5,IE,1509)
 +11       DO P
           if EX=U
               QUIT 
 +12       WRITE !,"     POLYPS OF STOMACH............: ",$$GET1^DIQ(165.5,IE,1510)
 +13       DO P
           if EX=U
               QUIT 
 +14       WRITE !,"     POLYPOSIS OF SMALL OR LARGE"
 +15       DO P
           if EX=U
               QUIT 
 +16       WRITE !,"      BOWEL.......................: ",$$GET1^DIQ(165.5,IE,1511)
 +17       DO P
           if EX=U
               QUIT 
 +18       WRITE !,"     BARRETT'S ESOPHAGUS..........: ",$$GET1^DIQ(165.5,IE,1512)
 +19       DO P
           if EX=U
               QUIT 
 +20       WRITE !,"     ATROPHIC GASTRITIS...........: ",$$GET1^DIQ(165.5,IE,1513)
 +21       DO P
           if EX=U
               QUIT 
 +22       WRITE !,"     GASTRIC METAPLASIA...........: ",$$GET1^DIQ(165.5,IE,1514)
 +23       IF IOST?1"C".E
               WRITE !
               KILL DIR
               SET DIR(0)="E"
               DO ^DIR
               if 'Y
                   QUIT 
               DO HEAD^ONCGPC0
               GOTO ITEM10
 +24       WRITE !
 +25       DO P
           if EX=U
               QUIT 
ITEM10     WRITE !,"10. H-PYLORI DRUGS GIVEN:"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     ANTIBIOTICS..................: ",$$GET1^DIQ(165.5,IE,1515)
 +3        DO P
           if EX=U
               QUIT 
 +4        WRITE !,"     PROTON PUMP INHIBITORS.......: ",$$GET1^DIQ(165.5,IE,1516)
 +5        DO P
           if EX=U
               QUIT 
 +6        WRITE !,"     H2 BLOCKERS..................: ",$$GET1^DIQ(165.5,IE,1517)
 +7        DO P
           if EX=U
               QUIT 
 +8        WRITE !,"     BISMUTH COMPOUNDS............: ",$$GET1^DIQ(165.5,IE,1518)
 +9        DO P
           if EX=U
               QUIT 
 +10       WRITE !
 +11       DO P
           if EX=U
               QUIT 
ITEM11     WRITE !,"11. PRIOR INTRA-ABDOMINAL SURGERY.: ",$$GET1^DIQ(165.5,IE,1519)
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !
 +3        DO P
           if EX=U
               QUIT 
ITEM12     WRITE !,"12. YEAR OF PRIOR GASTRIC"
 +1        DO P
           if EX=U
               QUIT 
 +2        WRITE !,"     RESECTION....................: ",$$GET1^DIQ(165.5,IE,1520)
 +3        DO P
           if EX=U
               QUIT 
 +4        IF IOST?1"C".E
               WRITE !
               KILL DIR
               SET DIR(0)="E"
               DO ^DIR
               if 'Y
                   QUIT 
 +5        IF IOST?1"C".E
               DO HEAD^ONCGPC0
 +6        DO ^ONCGPC7A
KILL      ;
 +1        KILL CS,CSDAT,CSI,CSPNT,DESC,DESC1,DESC2,DLC,DOFCT
 +2        KILL EX,IE,LIN,LINE,LOS,NOP,ONCOLST,TABLE
 +3        KILL %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
 +4        QUIT 
P         ;Print
 +1        IF ($Y'<(LIN-1))
               Begin DoDot:1
 +2                IF IOST?1"C".E
                       WRITE !
                       KILL DIR
                       SET DIR(0)="E"
                       DO ^DIR
                       IF 'Y
                           SET EX=U
                           QUIT 
 +3                DO HEAD^ONCGPC0
                   QUIT 
               End DoDot:1
               if EX=U
                   QUIT 
 +4        QUIT 
TASK      ;Queue a task
 +1        KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
 +2        SET ZTRTN="PRT^ONCGPC7"
           SET ZTREQ="@"
           SET ZTSAVE("ZTREQ")=""
 +3        SET ZTDESC="Print Gastric Cancers PCE"
 +4        FOR V2=1:1
               SET V1=$PIECE(ONCOLST,"^",V2)
               if V1=""
                   QUIT 
               SET ZTSAVE(V1)=""
 +5        DO ^%ZTLOAD
           DO ^%ZISC
           USE IO
           WRITE !,"Request Queued",!
 +6        KILL V1,V2,ONCOLST,ZTSK
           QUIT