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