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 Oct 16, 2024@18:23:42 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
