ONCRR ;Hines OIFO/GWB - RECONSTRUCTION/RESTORATION ;09/21/04
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
RRIT ;RECONSTRUCTION/RESTORATION (165.5,23)
;INPUT
S NTXDD=$G(NTXDD) I NTXDD="" Q
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
I SCDXDT<2980000 D I $D(X),NTXDD=1 S V=1 D NT^ONCODSR
.K DIC S DIC="^ONCO(160.4," D ^DIC
.I Y=-1 K X Q
.S X=$P(Y,U,1) W " ",$P(^ONCO(160.4,X,0),U,2)
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.S FOUND=0
.F XRR=0:0 S XRR=$O(^ONCO(164,ICD,"RR5",XRR)) Q:XRR'>0!(FOUND=1) D
..I $P(^ONCO(164,ICD,"RR5",XRR,0),U,2)=X S X=XRR,FOUND=1 Q
.I FOUND=0 K X Q
.W " ",$P(^ONCO(164,ICD,"RR5",X,0),U,1)
I $D(X),NTXDD=1 S V=1 D NT^ONCODSR
K SCDXDT,FOUND,ICD,TOP,XRR Q
;
RROT ;OUTPUT
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.S:Y'="" Y=$P($G(^ONCO(160.4,Y,0)),U,2)
I SCDXDT>2971231 D
.Q:Y=""
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.S Y=$P($G(^ONCO(164,ICD,"RR5",Y,0)),U,1)
K SCDXDT,ICD,TOP Q
;
RRHP ;HELP
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.W !?3,"Select from the following list:"
.F XRR=0:0 S XRR=$O(^ONCO(160.4,XRR)) Q:XRR'>0 W !?6,$P($G(^ONCO(160.4,XRR,0)),U,1),?12,$P($G(^ONCO(160.4,XRR,0)),U,2)
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.W !?3,"Select from the following list:",!
.F XRR=0:0 S XRR=$O(^ONCO(164,ICD,"RR5",XRR)) Q:XRR'>0 W !?6,$P($G(^ONCO(164,ICD,"RR5",XRR,0)),U,2),?12,$P($G(^ONCO(164,ICD,"RR5",XRR,0)),U,1)
K SCDXDT,ICD,TOP,XRR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCRR 2163 printed Dec 13, 2024@02:27:41 Page 2
ONCRR ;Hines OIFO/GWB - RECONSTRUCTION/RESTORATION ;09/21/04
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
RRIT ;RECONSTRUCTION/RESTORATION (165.5,23)
+1 ;INPUT
+2 SET NTXDD=$GET(NTXDD)
IF NTXDD=""
QUIT
+3 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
KILL X
QUIT
+4 IF SCDXDT<2980000
Begin DoDot:1
+5 KILL DIC
SET DIC="^ONCO(160.4,"
DO ^DIC
+6 IF Y=-1
KILL X
QUIT
+7 SET X=$PIECE(Y,U,1)
WRITE " ",$PIECE(^ONCO(160.4,X,0),U,2)
End DoDot:1
IF $DATA(X)
IF NTXDD=1
SET V=1
DO NT^ONCODSR
+8 IF SCDXDT>2971231
Begin DoDot:1
+9 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE " No TOPOGRAPHY!"
KILL X
QUIT
+10 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
KILL X
QUIT
+11 ;ROADS D-cxliii
+12 IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+13 SET FOUND=0
+14 FOR XRR=0:0
SET XRR=$ORDER(^ONCO(164,ICD,"RR5",XRR))
if XRR'>0!(FOUND=1)
QUIT
Begin DoDot:2
+15 IF $PIECE(^ONCO(164,ICD,"RR5",XRR,0),U,2)=X
SET X=XRR
SET FOUND=1
QUIT
End DoDot:2
+16 IF FOUND=0
KILL X
QUIT
+17 WRITE " ",$PIECE(^ONCO(164,ICD,"RR5",X,0),U,1)
End DoDot:1
+18 IF $DATA(X)
IF NTXDD=1
SET V=1
DO NT^ONCODSR
+19 KILL SCDXDT,FOUND,ICD,TOP,XRR
QUIT
+20 ;
RROT ;OUTPUT
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 if Y'=""
SET Y=$PIECE($GET(^ONCO(160.4,Y,0)),U,2)
End DoDot:1
+4 IF SCDXDT>2971231
Begin DoDot:1
+5 if Y=""
QUIT
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
SET Y=""
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+8 ;ROADS D-cxliii
+9 IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+10 SET Y=$PIECE($GET(^ONCO(164,ICD,"RR5",Y,0)),U,1)
End DoDot:1
+11 KILL SCDXDT,ICD,TOP
QUIT
+12 ;
RRHP ;HELP
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 WRITE !?3,"Select from the following list:"
+4 FOR XRR=0:0
SET XRR=$ORDER(^ONCO(160.4,XRR))
if XRR'>0
QUIT
WRITE !?6,$PIECE($GET(^ONCO(160.4,XRR,0)),U,1),?12,$PIECE($GET(^ONCO(160.4,XRR,0)),U,2)
End DoDot:1
+5 IF SCDXDT>2971231
Begin DoDot:1
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+8 ;ROADS D-cxliii
+9 IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+10 WRITE !?3,"Select from the following list:",!
+11 FOR XRR=0:0
SET XRR=$ORDER(^ONCO(164,ICD,"RR5",XRR))
if XRR'>0
QUIT
WRITE !?6,$PIECE($GET(^ONCO(164,ICD,"RR5",XRR,0)),U,2),?12,$PIECE($GET(^ONCO(164,ICD,"RR5",XRR,0)),U,1)
End DoDot:1
+12 KILL SCDXDT,ICD,TOP,XRR
QUIT
