ONCOPA3 ;Hines OIFO/GWB - [PA Print Complete Abstract (132c)] continued ;10/07/11
;;2.2;ONCOLOGY;**1,12**;Jul 31, 2013;Build 8
;
N ALHS,ALTP,ALZN,CFH,CHST,NOK,OC,OCCP,RCDT,TBHS,TBTP,TBZN,TX,Y
S NAME="PERSONAL DATA" D FORMAT^ONCOPA1
W !!,TITLE
W !!?10," Address at Dx: ",ONCAB(165.5,IEN,8)
W !?10," Address at Dx - Supp: ",ONCAB(165.5,IEN,8.2)
W !?10," City/Town at Dx: ",ONCAB(165.5,IEN,8.1),?70," Place of Birth: ",ONCAB(160,PTIEN,7) D P Q:EX=U
W !?10," State at Dx: ",ONCAB(165.5,IEN,16),?70," Religion: ",$E(ONCAB(160,PTIEN,13),1,14) D P Q:EX=U
W !?10," Postal Code at Dx: ",ONCAB(165.5,IEN,9),?69,"Marital Status at Dx: ",ONCAB(165.5,IEN,11) D P Q:EX=U
W !?10," County at Dx: ",ONCAB(165.5,IEN,10),?70,"Primary Payer at Dx: ",ONCAB(165.5,IEN,18) D P Q:EX=U
W !?10," Telephone: ",ONCAB(160,PTIEN,.131)
S NOK=""
I $D(^ONCO(160,PTIEN,0)) S RCDT=$G(^ONCO(160,PTIEN,0)) I $P(RCDT,";",2)["DPT",$D(^DPT($P(RCDT,";",1),.21)) S NOK=$P(^(.21),U)_" ("_$P(^(.21),U,2)_")"
I ESPD=1 S NOK="XXXXX,XXXXX"
W ?70," Next of Kin: ",NOK D P Q:EX=U
W !?10," Abstract Status: ",ONCAB(165.5,IEN,91) D P Q:EX=U
W !?10," Date of First Contact: ",ONCAB(165.5,IEN,155) D P Q:EX=U
W !?10," Date Case Completed: ",ONCAB(165.5,IEN,90) D P Q:EX=U
W !?8,"Elapsed Months to Completion: ",ONCAB(165.5,IEN,157.1,"E") D P Q:EX=U
W !?10," Abstracted by: ",ONCAB(165.5,IEN,92) D P Q:EX=U
W !
W !?1," Other Cancer: ",ONCAB(165.5,IEN,148,"E") D P Q:EX=U
W !?1," Cancer #1: ",ONCAB(165.5,IEN,148.1,"E") D P Q:EX=U
W !?1," Cancer #2: ",ONCAB(165.5,IEN,148.2,"E") D P Q:EX=U
W !?1," Cancer #3: ",ONCAB(165.5,IEN,148.3,"E") D P Q:EX=U
W !?1," Cancer #4: ",ONCAB(165.5,IEN,148.4,"E") D P Q:EX=U
W !!?7,"Agent Orange Exposure: ",ONCAB(160,PTIEN,48) D P Q:EX=U
W !?1,"Ionizing Radiation Exposure: ",ONCAB(160,PTIEN,50) D P Q:EX=U
W !?1," Chemical Exposure: ",ONCAB(160,PTIEN,52) D P Q:EX=U
W !?1," Asbestos Exposure: ",ONCAB(160,PTIEN,61) D P Q:EX=U
W !?1," Vietnam Service: ",ONCAB(160,PTIEN,62) D P Q:EX=U
W !?1," Lebanon Service: ",ONCAB(160,PTIEN,55) D P Q:EX=U
W !?1," Grenada Service: ",ONCAB(160,PTIEN,63) D P Q:EX=U
W !?1," Panama Service: ",ONCAB(160,PTIEN,64) D P Q:EX=U
W !?1," Persian Gulf Service: ",ONCAB(160,PTIEN,51) D P Q:EX=U
W !?1," Somalia Service: ",ONCAB(160,PTIEN,56) D P Q:EX=U
W !?1," Yugoslavia Service: ",ONCAB(160,PTIEN,65) D P Q:EX=U
W !?1," Afghanistan (OEF) Service: ",ONCAB(160,PTIEN,67) D P Q:EX=U
W !?1," Iraq (OIF) Service: ",ONCAB(160,PTIEN,66) D P Q:EX=U
W !?1," Branch of Service: ",ONCAB(160,PTIEN,68) D P Q:EX=U
W !!?1," Source Comorbidity: ",ONCAB(160,PTIEN,1006) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 1: ",ONCAB(160,PTIEN,25) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 2: ",ONCAB(160,PTIEN,25.1) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 3: ",ONCAB(160,PTIEN,25.2) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 4: ",ONCAB(160,PTIEN,25.3) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 5: ",ONCAB(160,PTIEN,25.4) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 6: ",ONCAB(160,PTIEN,25.5) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 7: ",ONCAB(160,PTIEN,25.6) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 8: ",ONCAB(160,PTIEN,25.7) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 9: ",ONCAB(160,PTIEN,25.8) D P Q:EX=U
I DATEDX<3160000 W !?1,"Comorbidity/Complication 10: ",ONCAB(160,PTIEN,25.9) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #1: ",ONCAB(160,PTIEN,25.91) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #2: ",ONCAB(160,PTIEN,25.92) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #3: ",ONCAB(160,PTIEN,25.93) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #4: ",ONCAB(160,PTIEN,25.94) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #5: ",ONCAB(160,PTIEN,25.95) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #6: ",ONCAB(160,PTIEN,25.96) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #7: ",ONCAB(160,PTIEN,25.97) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #8: ",ONCAB(160,PTIEN,25.98) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #9: ",ONCAB(160,PTIEN,25.99) D P Q:EX=U
I DATEDX>3151231 W !?1," Secondary Diagnosis #10: ",ONCAB(160,PTIEN,25.9901) D P Q:EX=U
S NAME="EMPLOYMENT HISTORY" D FORMAT^ONCOPA1
W !!,TITLE,!
I $D(^ONCO(160,PTIEN,7,0)) F OC=0:0 S OC=$O(^ONCO(160,PTIEN,7,OC)) Q:OC'>0 D
.S OCCP=$P($G(^ONCO(160,PTIEN,7,OC,0)),U,1) I OCCP="" Q
.W !," Occupation: ",$E(OCCP,1,24) D P Q:EX=U
.W !,"Usual Industry: ",$E($P($G(^ONCO(160,PTIEN,7,OC,0)),U,4),1,22) D P Q:EX=U
.W ! D P Q:EX=U
S NAME="TOBACCO AND ALCOHOL USAGE" D FORMAT^ONCOPA1
W !,TITLE
W !!?15," TOBACCO HISTORY: ",ONCAB(160,PTIEN,38) D P Q:EX=U
F TBHS=0:0 S TBHS=$O(^ONCO(160,PTIEN,5,TBHS)) Q:TBHS'>0 D
.S TBZN=$G(^ONCO(160,PTIEN,5,TBHS,0)) S TBTP=$P(TBZN,U,1) I TBTP="" Q
.W !?3,"Type of Tobacco User: ",$S(TBTP=1:"CIGARETTE",TBTP=2:"CIGARS",TBTP=3:"PIPE",TBTP=4:"CHEWING TOBACCO",TBTP=5:"SNUFF",TBTP=6:"MARIJUANA",TBTP=7:"MORE THAN 1 TYPE",TBTP=8:"UNKNOWN",1:"")
.W ?55,"Pack-Years: ",$S($P(TBZN,U,2)="U":"UNK",1:$P(TBZN,U,2))
.W ?77,"Year Quit Tobacco Use: " S Y=$P(TBZN,U,3) W:Y="U" "UNK" I +Y D DD^%DT W Y
.Q
W !!?15," ALCOHOL HISTORY: ",ONCAB(160,PTIEN,39) D P Q:EX=U
F ALHS=0:0 S ALHS=$O(^ONCO(160,PTIEN,6,ALHS)) Q:ALHS'>0 D
.S ALZN=$G(^ONCO(160,PTIEN,6,ALHS,0)) S ALTP=$P(ALZN,U,1) I ALTP="" Q
.W !?3,"Type of Alcohol User: ",$S(ALTP="B":"BEER",ALTP="W":"WINE",ALTP="H":"HARD LIQUOR",ALTP="M":"MODERATE/SOCIAL",ALTP="S":"SERIOUS/HEAVY",ALTP="U":"UNKNOWN",1:"")
.W ?45,"Years of Alcohol Use: ",$S($P(ALZN,U,2)="U":"UNK",1:$P(ALZN,U,2))
.W ?77,"Drinks Per Day: ",$S($P(ALZN,U,3)="U":"UNK",1:$P(ALZN,U,3))
.W ?100,"Year Quit Drinking: " S Y=$P(ALZN,U,4) W:Y="U" "UNK" I +Y D DD^%DT W Y
.Q
S CFH=ONCAB(160,PTIEN,43),NAME="CANCER FAMILY HISTORY: "_CFH
D FORMAT^ONCOPA1 W !!,TITLE,!
F CHST=0:0 S CHST=$O(ONCAB(160.044,CHST)) Q:CHST'>0 D
.W !," Family member with cancer: ",ONCAB(160.044,CHST,.01)
.W ?50," Cancer: ",ONCAB(160.044,CHST,1) D P Q:EX=U
.Q
S NAME="PHYSICIAN CONTACTS " D FORMAT^ONCOPA1
W !!,TITLE
I DATEDX>3061231 D
.W !," Managing Physician: ",ONCAB(165.5,IEN,2.2,"E") D P Q:EX=U
W !," Following Physician: ",ONCAB(165.5,IEN,2.1) D P Q:EX=U
W !," Primary Surgeon: ",ONCAB(165.5,IEN,2) D P Q:EX=U
W !," Physician #3: ",ONCAB(165.5,IEN,2.3) D P Q:EX=U
W !," Physician #4: ",ONCAB(165.5,IEN,2.4) D P Q:EX=U
W !!," QA Selected: ",ONCAB(165.5,IEN,62) D P Q:EX=U
W ?25," QA Reviewer: ",ONCAB(165.5,IEN,64.1) D P Q:EX=U
W ?75," QA Date: ",ONCAB(165.5,IEN,64) D P Q:EX=U
W ?100," QA Review: ",ONCAB(165.5,IEN,63) D P Q:EX=U
W !," QA Findings: " F TX=0:0 S TX=$O(^ONCO(165.5,IEN,28,TX)) Q:TX'>0 W !?6,^ONCO(165.5,IEN,28,TX,0) D P Q:EX=U
;
I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR Q:'Y D HDR G PA3A
D P Q:EX=U
PA3A D ^ONCOPA3A
Q
P ;
I ($Y'<(LINE-1)) D Q:EX=U W !
.I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR I 'Y S EX=U Q
.D HDR Q
Q
HDR ; Header
W @IOF S PG=PG+1
W CRA,!
W ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
Q
;
CLEANUP ;Cleanup
K CRA,DATEDX,ESPD,EX,IEN,LINE,NAME,ONCAB,PATNAME,PG,PTIEN,SSAN,TITLE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPA3 7990 printed Apr 09, 2024@21:28:43 Page 2
ONCOPA3 ;Hines OIFO/GWB - [PA Print Complete Abstract (132c)] continued ;10/07/11
+1 ;;2.2;ONCOLOGY;**1,12**;Jul 31, 2013;Build 8
+2 ;
+3 NEW ALHS,ALTP,ALZN,CFH,CHST,NOK,OC,OCCP,RCDT,TBHS,TBTP,TBZN,TX,Y
+4 SET NAME="PERSONAL DATA"
DO FORMAT^ONCOPA1
+5 WRITE !!,TITLE
+6 WRITE !!?10," Address at Dx: ",ONCAB(165.5,IEN,8)
+7 WRITE !?10," Address at Dx - Supp: ",ONCAB(165.5,IEN,8.2)
+8 WRITE !?10," City/Town at Dx: ",ONCAB(165.5,IEN,8.1),?70," Place of Birth: ",ONCAB(160,PTIEN,7)
DO P
if EX=U
QUIT
+9 WRITE !?10," State at Dx: ",ONCAB(165.5,IEN,16),?70," Religion: ",$EXTRACT(ONCAB(160,PTIEN,13),1,14)
DO P
if EX=U
QUIT
+10 WRITE !?10," Postal Code at Dx: ",ONCAB(165.5,IEN,9),?69,"Marital Status at Dx: ",ONCAB(165.5,IEN,11)
DO P
if EX=U
QUIT
+11 WRITE !?10," County at Dx: ",ONCAB(165.5,IEN,10),?70,"Primary Payer at Dx: ",ONCAB(165.5,IEN,18)
DO P
if EX=U
QUIT
+12 WRITE !?10," Telephone: ",ONCAB(160,PTIEN,.131)
+13 SET NOK=""
+14 IF $DATA(^ONCO(160,PTIEN,0))
SET RCDT=$GET(^ONCO(160,PTIEN,0))
IF $PIECE(RCDT,";",2)["DPT"
IF $DATA(^DPT($PIECE(RCDT,";",1),.21))
SET NOK=$PIECE(^(.21),U)_" ("_$PIECE(^(.21),U,2)_")"
+15 IF ESPD=1
SET NOK="XXXXX,XXXXX"
+16 WRITE ?70," Next of Kin: ",NOK
DO P
if EX=U
QUIT
+17 WRITE !?10," Abstract Status: ",ONCAB(165.5,IEN,91)
DO P
if EX=U
QUIT
+18 WRITE !?10," Date of First Contact: ",ONCAB(165.5,IEN,155)
DO P
if EX=U
QUIT
+19 WRITE !?10," Date Case Completed: ",ONCAB(165.5,IEN,90)
DO P
if EX=U
QUIT
+20 WRITE !?8,"Elapsed Months to Completion: ",ONCAB(165.5,IEN,157.1,"E")
DO P
if EX=U
QUIT
+21 WRITE !?10," Abstracted by: ",ONCAB(165.5,IEN,92)
DO P
if EX=U
QUIT
+22 WRITE !
+23 WRITE !?1," Other Cancer: ",ONCAB(165.5,IEN,148,"E")
DO P
if EX=U
QUIT
+24 WRITE !?1," Cancer #1: ",ONCAB(165.5,IEN,148.1,"E")
DO P
if EX=U
QUIT
+25 WRITE !?1," Cancer #2: ",ONCAB(165.5,IEN,148.2,"E")
DO P
if EX=U
QUIT
+26 WRITE !?1," Cancer #3: ",ONCAB(165.5,IEN,148.3,"E")
DO P
if EX=U
QUIT
+27 WRITE !?1," Cancer #4: ",ONCAB(165.5,IEN,148.4,"E")
DO P
if EX=U
QUIT
+28 WRITE !!?7,"Agent Orange Exposure: ",ONCAB(160,PTIEN,48)
DO P
if EX=U
QUIT
+29 WRITE !?1,"Ionizing Radiation Exposure: ",ONCAB(160,PTIEN,50)
DO P
if EX=U
QUIT
+30 WRITE !?1," Chemical Exposure: ",ONCAB(160,PTIEN,52)
DO P
if EX=U
QUIT
+31 WRITE !?1," Asbestos Exposure: ",ONCAB(160,PTIEN,61)
DO P
if EX=U
QUIT
+32 WRITE !?1," Vietnam Service: ",ONCAB(160,PTIEN,62)
DO P
if EX=U
QUIT
+33 WRITE !?1," Lebanon Service: ",ONCAB(160,PTIEN,55)
DO P
if EX=U
QUIT
+34 WRITE !?1," Grenada Service: ",ONCAB(160,PTIEN,63)
DO P
if EX=U
QUIT
+35 WRITE !?1," Panama Service: ",ONCAB(160,PTIEN,64)
DO P
if EX=U
QUIT
+36 WRITE !?1," Persian Gulf Service: ",ONCAB(160,PTIEN,51)
DO P
if EX=U
QUIT
+37 WRITE !?1," Somalia Service: ",ONCAB(160,PTIEN,56)
DO P
if EX=U
QUIT
+38 WRITE !?1," Yugoslavia Service: ",ONCAB(160,PTIEN,65)
DO P
if EX=U
QUIT
+39 WRITE !?1," Afghanistan (OEF) Service: ",ONCAB(160,PTIEN,67)
DO P
if EX=U
QUIT
+40 WRITE !?1," Iraq (OIF) Service: ",ONCAB(160,PTIEN,66)
DO P
if EX=U
QUIT
+41 WRITE !?1," Branch of Service: ",ONCAB(160,PTIEN,68)
DO P
if EX=U
QUIT
+42 WRITE !!?1," Source Comorbidity: ",ONCAB(160,PTIEN,1006)
DO P
if EX=U
QUIT
+43 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 1: ",ONCAB(160,PTIEN,25)
DO P
if EX=U
QUIT
+44 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 2: ",ONCAB(160,PTIEN,25.1)
DO P
if EX=U
QUIT
+45 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 3: ",ONCAB(160,PTIEN,25.2)
DO P
if EX=U
QUIT
+46 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 4: ",ONCAB(160,PTIEN,25.3)
DO P
if EX=U
QUIT
+47 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 5: ",ONCAB(160,PTIEN,25.4)
DO P
if EX=U
QUIT
+48 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 6: ",ONCAB(160,PTIEN,25.5)
DO P
if EX=U
QUIT
+49 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 7: ",ONCAB(160,PTIEN,25.6)
DO P
if EX=U
QUIT
+50 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 8: ",ONCAB(160,PTIEN,25.7)
DO P
if EX=U
QUIT
+51 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 9: ",ONCAB(160,PTIEN,25.8)
DO P
if EX=U
QUIT
+52 IF DATEDX<3160000
WRITE !?1,"Comorbidity/Complication 10: ",ONCAB(160,PTIEN,25.9)
DO P
if EX=U
QUIT
+53 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #1: ",ONCAB(160,PTIEN,25.91)
DO P
if EX=U
QUIT
+54 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #2: ",ONCAB(160,PTIEN,25.92)
DO P
if EX=U
QUIT
+55 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #3: ",ONCAB(160,PTIEN,25.93)
DO P
if EX=U
QUIT
+56 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #4: ",ONCAB(160,PTIEN,25.94)
DO P
if EX=U
QUIT
+57 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #5: ",ONCAB(160,PTIEN,25.95)
DO P
if EX=U
QUIT
+58 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #6: ",ONCAB(160,PTIEN,25.96)
DO P
if EX=U
QUIT
+59 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #7: ",ONCAB(160,PTIEN,25.97)
DO P
if EX=U
QUIT
+60 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #8: ",ONCAB(160,PTIEN,25.98)
DO P
if EX=U
QUIT
+61 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #9: ",ONCAB(160,PTIEN,25.99)
DO P
if EX=U
QUIT
+62 IF DATEDX>3151231
WRITE !?1," Secondary Diagnosis #10: ",ONCAB(160,PTIEN,25.9901)
DO P
if EX=U
QUIT
+63 SET NAME="EMPLOYMENT HISTORY"
DO FORMAT^ONCOPA1
+64 WRITE !!,TITLE,!
+65 IF $DATA(^ONCO(160,PTIEN,7,0))
FOR OC=0:0
SET OC=$ORDER(^ONCO(160,PTIEN,7,OC))
if OC'>0
QUIT
Begin DoDot:1
+66 SET OCCP=$PIECE($GET(^ONCO(160,PTIEN,7,OC,0)),U,1)
IF OCCP=""
QUIT
+67 WRITE !," Occupation: ",$EXTRACT(OCCP,1,24)
DO P
if EX=U
QUIT
+68 WRITE !,"Usual Industry: ",$EXTRACT($PIECE($GET(^ONCO(160,PTIEN,7,OC,0)),U,4),1,22)
DO P
if EX=U
QUIT
+69 WRITE !
DO P
if EX=U
QUIT
End DoDot:1
+70 SET NAME="TOBACCO AND ALCOHOL USAGE"
DO FORMAT^ONCOPA1
+71 WRITE !,TITLE
+72 WRITE !!?15," TOBACCO HISTORY: ",ONCAB(160,PTIEN,38)
DO P
if EX=U
QUIT
+73 FOR TBHS=0:0
SET TBHS=$ORDER(^ONCO(160,PTIEN,5,TBHS))
if TBHS'>0
QUIT
Begin DoDot:1
+74 SET TBZN=$GET(^ONCO(160,PTIEN,5,TBHS,0))
SET TBTP=$PIECE(TBZN,U,1)
IF TBTP=""
QUIT
+75 WRITE !?3,"Type of Tobacco User: ",$SELECT(TBTP=1:"CIGARETTE",TBTP=2:"CIGARS",TBTP=3:"PIPE",TBTP=4:"CHEWING TOBACCO",TBTP=5:"SNUFF",TBTP=6:"MARIJUANA",TBTP=7:"MORE THAN 1 TYPE",TBTP=8:"UNKNOWN",1:"")
+76 WRITE ?55,"Pack-Years: ",$SELECT($PIECE(TBZN,U,2)="U":"UNK",1:$PIECE(TBZN,U,2))
+77 WRITE ?77,"Year Quit Tobacco Use: "
SET Y=$PIECE(TBZN,U,3)
if Y="U"
WRITE "UNK"
IF +Y
DO DD^%DT
WRITE Y
+78 QUIT
End DoDot:1
+79 WRITE !!?15," ALCOHOL HISTORY: ",ONCAB(160,PTIEN,39)
DO P
if EX=U
QUIT
+80 FOR ALHS=0:0
SET ALHS=$ORDER(^ONCO(160,PTIEN,6,ALHS))
if ALHS'>0
QUIT
Begin DoDot:1
+81 SET ALZN=$GET(^ONCO(160,PTIEN,6,ALHS,0))
SET ALTP=$PIECE(ALZN,U,1)
IF ALTP=""
QUIT
+82 WRITE !?3,"Type of Alcohol User: ",$SELECT(ALTP="B":"BEER",ALTP="W":"WINE",ALTP="H":"HARD LIQUOR",ALTP="M":"MODERATE/SOCIAL",ALTP="S":"SERIOUS/HEAVY",ALTP="U":"UNKNOWN",1:"")
+83 WRITE ?45,"Years of Alcohol Use: ",$SELECT($PIECE(ALZN,U,2)="U":"UNK",1:$PIECE(ALZN,U,2))
+84 WRITE ?77,"Drinks Per Day: ",$SELECT($PIECE(ALZN,U,3)="U":"UNK",1:$PIECE(ALZN,U,3))
+85 WRITE ?100,"Year Quit Drinking: "
SET Y=$PIECE(ALZN,U,4)
if Y="U"
WRITE "UNK"
IF +Y
DO DD^%DT
WRITE Y
+86 QUIT
End DoDot:1
+87 SET CFH=ONCAB(160,PTIEN,43)
SET NAME="CANCER FAMILY HISTORY: "_CFH
+88 DO FORMAT^ONCOPA1
WRITE !!,TITLE,!
+89 FOR CHST=0:0
SET CHST=$ORDER(ONCAB(160.044,CHST))
if CHST'>0
QUIT
Begin DoDot:1
+90 WRITE !," Family member with cancer: ",ONCAB(160.044,CHST,.01)
+91 WRITE ?50," Cancer: ",ONCAB(160.044,CHST,1)
DO P
if EX=U
QUIT
+92 QUIT
End DoDot:1
+93 SET NAME="PHYSICIAN CONTACTS "
DO FORMAT^ONCOPA1
+94 WRITE !!,TITLE
+95 IF DATEDX>3061231
Begin DoDot:1
+96 WRITE !," Managing Physician: ",ONCAB(165.5,IEN,2.2,"E")
DO P
if EX=U
QUIT
End DoDot:1
+97 WRITE !," Following Physician: ",ONCAB(165.5,IEN,2.1)
DO P
if EX=U
QUIT
+98 WRITE !," Primary Surgeon: ",ONCAB(165.5,IEN,2)
DO P
if EX=U
QUIT
+99 WRITE !," Physician #3: ",ONCAB(165.5,IEN,2.3)
DO P
if EX=U
QUIT
+100 WRITE !," Physician #4: ",ONCAB(165.5,IEN,2.4)
DO P
if EX=U
QUIT
+101 WRITE !!," QA Selected: ",ONCAB(165.5,IEN,62)
DO P
if EX=U
QUIT
+102 WRITE ?25," QA Reviewer: ",ONCAB(165.5,IEN,64.1)
DO P
if EX=U
QUIT
+103 WRITE ?75," QA Date: ",ONCAB(165.5,IEN,64)
DO P
if EX=U
QUIT
+104 WRITE ?100," QA Review: ",ONCAB(165.5,IEN,63)
DO P
if EX=U
QUIT
+105 WRITE !," QA Findings: "
FOR TX=0:0
SET TX=$ORDER(^ONCO(165.5,IEN,28,TX))
if TX'>0
QUIT
WRITE !?6,^ONCO(165.5,IEN,28,TX,0)
DO P
if EX=U
QUIT
+106 ;
+107 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue with this abstract"
DO ^DIR
if 'Y
QUIT
DO HDR
GOTO PA3A
+108 DO P
if EX=U
QUIT
PA3A DO ^ONCOPA3A
+1 QUIT
P ;
+1 IF ($Y'<(LINE-1))
Begin DoDot:1
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue with this abstract"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+3 DO HDR
QUIT
End DoDot:1
if EX=U
QUIT
WRITE !
+4 QUIT
HDR ; Header
+1 WRITE @IOF
SET PG=PG+1
+2 WRITE CRA,!
+3 WRITE ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
+4 QUIT
+5 ;
CLEANUP ;Cleanup
+1 KILL CRA,DATEDX,ESPD,EX,IEN,LINE,NAME,ONCAB,PATNAME,PG,PTIEN,SSAN,TITLE
