- ONCOXNC ; GENERATED FROM 'ONCO XINCIDENCE RPRT' PRINT TEMPLATE (#872) ; 12/17/21 ; (FILE 165.5, MARGIN=80)
- G BEGIN
- N W !
- T W:$X ! I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1)
- S DISTP=DISTP+1,DILCT=DILCT+1 D:'(DISTP#100) CSTP^DIO2
- Q
- DT I $G(DUZ("LANG"))>1,Y W $$OUT^DIALOGU(Y,"DD") Q
- X ^DD("DD")
- W Y Q
- M D @DIXX
- Q
- BEGIN ;
- S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)
- I $D(DXS)<9 M DXS=^DIPT(872,"DXS")
- S I(0)="^ONCO(165.5,",J(0)=165.5
- S I(100)="^ONCO(160,",J(100)=160 S I(0,0)=D0 S DIP(1)=$S($D(^ONCO(165.5,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X S D0=D(0) I D0>0 D A1
- G A1R
- A1 ;
- W ?0 X $P(^DD(160,1000,0),U,5,99) S Y(160,1000.1,1)=X S X=Y(160,1000.1,1),X=$J("",$S($D(DIWR)+$D(DIWL)=2:DIWR-DIWL+1,$D(IOM):IOM,1:80)-$L(X)\2-$X)_X W $E(X,1,96) K Y(160,1000.1)
- D T Q:'DN W ?0 X $P(^DD(160,1001,0),U,5,99) S Y(160,1001.1,1)=X S X=Y(160,1001.1,1),X=$J("",$S($D(DIWR)+$D(DIWL)=2:DIWR-DIWL+1,$D(IOM):IOM,1:80)-$L(X)\2-$X)_X W $E(X,1,96) K Y(160,1001.1)
- D T Q:'DN W ?0 X $P(^DD(160,1002,0),U,5,99) S Y(160,1002.1,1)=X S X=Y(160,1002.1,1),X=$J("",$S($D(DIWR)+$D(DIWL)=2:DIWR-DIWL+1,$D(IOM):IOM,1:80)-$L(X)\2-$X)_X W $E(X,1,96) K Y(160,1002.1)
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- S X=$G(^ONCO(160,D0,0)) D N:$X>4 Q:'DN W ?4 S Y=$P(X,U,1) S C=$P(^DD(160,.01,0),U,2) D Y^DIQ:Y S C="," W $E(Y,1,30)
- D N:$X>44 Q:'DN W ?44 X "N I,Y "_$P(^DD(160,1003,0),U,5,99) S DIP(101)=X S X="State Hospital No: "_DIP(101) K DIP K:DN Y W X
- D N:$X>4 Q:'DN W ?4 S X="" D ADD^ONCOES W $E(X,1,50) K Y(160,.119)
- D N:$X>4 Q:'DN W ?4 S X="" D ZIPCT^ONCOES W $E(X,1,50) K Y(160,.118)
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>19 Q:'DN W ?19 W "****************************************" K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>4 Q:'DN W ?4 X "N I,Y "_$P(^DD(160,2,0),U,5,99) S DIP(101)=X S X="SSN: "_DIP(101) K DIP K:DN Y W X
- W ?4 D DOB^ONCOES K DIP K:DN Y
- D N:$X>44 Q:'DN W ?44 W "DOB: "_X K DIP K:DN Y
- D N:$X>4 Q:'DN W ?4 S DIP(102)=$C(59)_$P($G(^DD(160,10,0)),U,3),DIP(101)=$S($D(^ONCO(160,D0,0)):^(0),1:"") S X="SEX: "_$P($P(DIP(102),$C(59)_$P(DIP(101),U,8)_":",2),$C(59)) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 S DIP(101)=$S($D(^ONCO(160,D0,0)):^(0),1:"") S X="POB: "_$P($G(^ONCO(165.2,+$P(DIP(101),U,5),0)),U) K DIP K:DN Y W X
- D N:$X>4 Q:'DN W ?4 S DIP(101)=$S($D(^ONCO(160,D0,0)):^(0),1:"") S X="RACE: "_$P($G(^ONCO(164.46,+$P(DIP(101),U,6),0)),U) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 X DXS(1,9) K DIP K:DN Y W $E(X,1,36)
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>19 Q:'DN W ?19 W "****************************************" K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- Q
- A1R ;
- K J(100),I(100) S:$D(I(0,0)) D0=I(0,0)
- D N:$X>4 Q:'DN W ?4 W "DATE DX: " K DIP K:DN Y
- S X=$G(^ONCO(165.5,D0,0)) D N:$X>13 Q:'DN W ?13 S Y=$P(X,U,16) S Y(0)=Y S X=Y D DATEOT^ONCOES W $E(Y,1,10)
- D N:$X>44 Q:'DN W ?44 S DIP(1)=$S($D(^ONCO(165.5,D0,2)):^(2),1:"") S X="IDCO SITE: "_$P($G(^ONCO(164,+$P(DIP(1),U,1),0)),U) K DIP K:DN Y W X
- D N:$X>4 Q:'DN W ?4 S DIP(1)=$S($D(^ONCO(165.5,D0,2.2)):^(2.2),1:"") S X="HISTOLOGY (ICD-O-3): "_$P($G(^ONCO(169.3,+$P(DIP(1),U,3),0)),U) K DIP K:DN Y W $E(X,1,38)
- D N:$X>44 Q:'DN W ?44 X DXS(2,9) K DIP K:DN Y W $E(X,1,36)
- D N:$X>4 Q:'DN W ?4 N DIERR S DIP(1)=$S($D(^ONCO(165.5,D0,2)):^(2),1:"") S X="GRADE: "_$$EXTERNAL^DIDU(165.5,24,"",$P(DIP(1),U,5)) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 X DXS(3,9) K DIP K:DN Y W $E(X,1,36)
- D N:$X>4 Q:'DN W ?4 X DXS(4,9) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 X DXS(5,9) K DIP K:DN Y W $E(X,1,36)
- D N:$X>4 Q:'DN W ?4 S DIP(1)=$S($D(^ONCO(165.5,D0,0)):^(0),1:"") S X="Sequence Number: "_$P(DIP(1),U,6) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 S DIP(1)=$S($D(^ONCO(165.5,D0,0)):^(0),1:"") S X="Primary Physician: "_$P($G(^ONCO(165,+$P(DIP(1),U,12),0)),U) K DIP K:DN Y W $E(X,1,35)
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>19 Q:'DN W ?19 W "***************************************" K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- W ?0 D PDLC^ONCOCRF,DATEOT^ONCOES K DIP K:DN Y
- D N:$X>4 Q:'DN W ?4 W "DATE of LAST CONTACT: "_X K DIP K:DN Y
- D N:$X>44 Q:'DN W ?44 X "N I,Y "_$P(^DD(165.5,.091,0),U,5,99) S DIP(1)=X S X="VITAL STATUS: "_DIP(1) K DIP K:DN Y W X
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>19 Q:'DN W ?19 W "***************************************" K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>0 Q:'DN W ?0 W " " K DIP K:DN Y
- D N:$X>4 Q:'DN W ?4 S DIP(1)=$S($D(^ONCO(165.5,D0,7)):^(7),1:"") S X="ABSTRACTER: "_$P($G(^VA(200,+$P(DIP(1),U,3),0)),U) K DIP K:DN Y W X
- D N:$X>44 Q:'DN W ?44 W "DATE CASE COMPLETED: " K DIP K:DN Y
- S X=$G(^ONCO(165.5,D0,7)) D N:$X>65 Q:'DN W ?65 S Y=$P(X,U,1) S Y(0)=Y S X=Y D DATEOT^ONCOES W $E(Y,1,10)
- K Y
- Q
- HEAD ;
- W !,"--------------------------------------------------------------------------------",!!
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOXNC 5330 printed Apr 23, 2025@18:41:04 Page 2
- ONCOXNC ; GENERATED FROM 'ONCO XINCIDENCE RPRT' PRINT TEMPLATE (#872) ; 12/17/21 ; (FILE 165.5, MARGIN=80)
- +1 GOTO BEGIN
- N WRITE !
- T if $X
- WRITE !
- IF '$DATA(DIOT(2))
- IF DN
- IF $DATA(IOSL)
- IF $SELECT('$DATA(DIWF):1,$PIECE(DIWF,"B",2):$PIECE(DIWF,"B",2),1:1)+$Y'<IOSL
- IF $DATA(^UTILITY($JOB,1))#2
- IF ^(1)?1U1P1E.E
- XECUTE ^(1)
- +1 SET DISTP=DISTP+1
- SET DILCT=DILCT+1
- if '(DISTP#100)
- DO CSTP^DIO2
- +2 QUIT
- DT IF $GET(DUZ("LANG"))>1
- IF Y
- WRITE $$OUT^DIALOGU(Y,"DD")
- QUIT
- +1 XECUTE ^DD("DD")
- +2 WRITE Y
- QUIT
- M DO @DIXX
- +1 QUIT
- BEGIN ;
- +1 if '$DATA(DN)
- SET DN=1
- SET DISTP=$GET(DISTP)
- SET DILCT=$GET(DILCT)
- +2 IF $DATA(DXS)<9
- MERGE DXS=^DIPT(872,"DXS")
- +3 SET I(0)="^ONCO(165.5,"
- SET J(0)=165.5
- +4 SET I(100)="^ONCO(160,"
- SET J(100)=160
- SET I(0,0)=D0
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,0)):^(0),1:"")
- SET X=$PIECE(DIP(1),U,2)
- SET X=X
- SET D(0)=+X
- SET D0=D(0)
- IF D0>0
- DO A1
- +5 GOTO A1R
- A1 ;
- +1 WRITE ?0
- XECUTE $PIECE(^DD(160,1000,0),U,5,99)
- SET Y(160,1000.1,1)=X
- SET X=Y(160,1000.1,1)
- SET X=$JUSTIFY("",$SELECT($DATA(DIWR)+$DATA(DIWL)=2:DIWR-DIWL+1,$DATA(IOM):IOM,1:80)-$LENGTH(X)\2-$X)_X
- WRITE $EXTRACT(X,1,96)
- KILL Y(160,1000.1)
- +2 DO T
- if 'DN
- QUIT
- WRITE ?0
- XECUTE $PIECE(^DD(160,1001,0),U,5,99)
- SET Y(160,1001.1,1)=X
- SET X=Y(160,1001.1,1)
- SET X=$JUSTIFY("",$SELECT($DATA(DIWR)+$DATA(DIWL)=2:DIWR-DIWL+1,$DATA(IOM):IOM,1:80)-$LENGTH(X)\2-$X)_X
- WRITE $EXTRACT(X,1,96)
- KILL Y(160,1001.1)
- +3 DO T
- if 'DN
- QUIT
- WRITE ?0
- XECUTE $PIECE(^DD(160,1002,0),U,5,99)
- SET Y(160,1002.1,1)=X
- SET X=Y(160,1002.1,1)
- SET X=$JUSTIFY("",$SELECT($DATA(DIWR)+$DATA(DIWL)=2:DIWR-DIWL+1,$DATA(IOM):IOM,1:80)-$LENGTH(X)\2-$X)_X
- WRITE $EXTRACT(X,1,96)
- KILL Y(160,1002.1)
- +4 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +5 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +6 SET X=$GET(^ONCO(160,D0,0))
- if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET Y=$PIECE(X,U,1)
- SET C=$PIECE(^DD(160,.01,0),U,2)
- if Y
- DO Y^DIQ
- SET C=","
- WRITE $EXTRACT(Y,1,30)
- +7 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE "N I,Y "_$PIECE(^DD(160,1003,0),U,5,99)
- SET DIP(101)=X
- SET X="State Hospital No: "_DIP(101)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +8 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET X=""
- DO ADD^ONCOES
- WRITE $EXTRACT(X,1,50)
- KILL Y(160,.119)
- +9 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET X=""
- DO ZIPCT^ONCOES
- WRITE $EXTRACT(X,1,50)
- KILL Y(160,.118)
- +10 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +11 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +12 if $X>19
- DO N
- if 'DN
- QUIT
- WRITE ?19
- WRITE "****************************************"
- KILL DIP
- if DN
- KILL Y
- +13 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +14 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +15 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- XECUTE "N I,Y "_$PIECE(^DD(160,2,0),U,5,99)
- SET DIP(101)=X
- SET X="SSN: "_DIP(101)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +16 WRITE ?4
- DO DOB^ONCOES
- KILL DIP
- if DN
- KILL Y
- +17 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- WRITE "DOB: "_X
- KILL DIP
- if DN
- KILL Y
- +18 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET DIP(102)=$CHAR(59)_$PIECE($GET(^DD(160,10,0)),U,3)
- SET DIP(101)=$SELECT($DATA(^ONCO(160,D0,0)):^(0),1:"")
- SET X="SEX: "_$PIECE($PIECE(DIP(102),$CHAR(59)_$PIECE(DIP(101),U,8)_":",2),$CHAR(59))
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +19 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- SET DIP(101)=$SELECT($DATA(^ONCO(160,D0,0)):^(0),1:"")
- SET X="POB: "_$PIECE($GET(^ONCO(165.2,+$PIECE(DIP(101),U,5),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +20 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET DIP(101)=$SELECT($DATA(^ONCO(160,D0,0)):^(0),1:"")
- SET X="RACE: "_$PIECE($GET(^ONCO(164.46,+$PIECE(DIP(101),U,6),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +21 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE DXS(1,9)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,36)
- +22 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +23 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +24 if $X>19
- DO N
- if 'DN
- QUIT
- WRITE ?19
- WRITE "****************************************"
- KILL DIP
- if DN
- KILL Y
- +25 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +26 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +27 QUIT
- A1R ;
- +1 KILL J(100),I(100)
- if $DATA(I(0,0))
- SET D0=I(0,0)
- +2 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- WRITE "DATE DX: "
- KILL DIP
- if DN
- KILL Y
- +3 SET X=$GET(^ONCO(165.5,D0,0))
- if $X>13
- DO N
- if 'DN
- QUIT
- WRITE ?13
- SET Y=$PIECE(X,U,16)
- SET Y(0)=Y
- SET X=Y
- DO DATEOT^ONCOES
- WRITE $EXTRACT(Y,1,10)
- +4 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,2)):^(2),1:"")
- SET X="IDCO SITE: "_$PIECE($GET(^ONCO(164,+$PIECE(DIP(1),U,1),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +5 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,2.2)):^(2.2),1:"")
- SET X="HISTOLOGY (ICD-O-3): "_$PIECE($GET(^ONCO(169.3,+$PIECE(DIP(1),U,3),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,38)
- +6 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE DXS(2,9)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,36)
- +7 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- NEW DIERR
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,2)):^(2),1:"")
- SET X="GRADE: "_$$EXTERNAL^DIDU(165.5,24,"",$PIECE(DIP(1),U,5))
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +8 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE DXS(3,9)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,36)
- +9 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- XECUTE DXS(4,9)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +10 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE DXS(5,9)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,36)
- +11 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,0)):^(0),1:"")
- SET X="Sequence Number: "_$PIECE(DIP(1),U,6)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +12 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,0)):^(0),1:"")
- SET X="Primary Physician: "_$PIECE($GET(^ONCO(165,+$PIECE(DIP(1),U,12),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE $EXTRACT(X,1,35)
- +13 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +14 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +15 if $X>19
- DO N
- if 'DN
- QUIT
- WRITE ?19
- WRITE "***************************************"
- KILL DIP
- if DN
- KILL Y
- +16 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +17 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +18 WRITE ?0
- DO PDLC^ONCOCRF
- DO DATEOT^ONCOES
- KILL DIP
- if DN
- KILL Y
- +19 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- WRITE "DATE of LAST CONTACT: "_X
- KILL DIP
- if DN
- KILL Y
- +20 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- XECUTE "N I,Y "_$PIECE(^DD(165.5,.091,0),U,5,99)
- SET DIP(1)=X
- SET X="VITAL STATUS: "_DIP(1)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +21 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +22 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +23 if $X>19
- DO N
- if 'DN
- QUIT
- WRITE ?19
- WRITE "***************************************"
- KILL DIP
- if DN
- KILL Y
- +24 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +25 if $X>0
- DO N
- if 'DN
- QUIT
- WRITE ?0
- WRITE " "
- KILL DIP
- if DN
- KILL Y
- +26 if $X>4
- DO N
- if 'DN
- QUIT
- WRITE ?4
- SET DIP(1)=$SELECT($DATA(^ONCO(165.5,D0,7)):^(7),1:"")
- SET X="ABSTRACTER: "_$PIECE($GET(^VA(200,+$PIECE(DIP(1),U,3),0)),U)
- KILL DIP
- if DN
- KILL Y
- WRITE X
- +27 if $X>44
- DO N
- if 'DN
- QUIT
- WRITE ?44
- WRITE "DATE CASE COMPLETED: "
- KILL DIP
- if DN
- KILL Y
- +28 SET X=$GET(^ONCO(165.5,D0,7))
- if $X>65
- DO N
- if 'DN
- QUIT
- WRITE ?65
- SET Y=$PIECE(X,U,1)
- SET Y(0)=Y
- SET X=Y
- DO DATEOT^ONCOES
- WRITE $EXTRACT(Y,1,10)
- +29 KILL Y
- +30 QUIT
- HEAD ;
- +1 WRITE !,"--------------------------------------------------------------------------------",!!
