| [613] | 1 | ONCRR ;Hines OIFO/GWB - RECONSTRUCTION/RESTORATION ;09/21/04
|
|---|
| 2 | ;;2.11;ONCOLOGY;**41**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | RRIT ;RECONSTRUCTION/RESTORATION (165.5,23)
|
|---|
| 5 | ;INPUT
|
|---|
| 6 | S NTXDD=$G(NTXDD) I NTXDD="" Q
|
|---|
| 7 | S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
|
|---|
| 8 | I SCDXDT<2980000 D I $D(X),NTXDD=1 S V=1 D NT^ONCODSR
|
|---|
| 9 | .K DIC S DIC="^ONCO(160.4," D ^DIC
|
|---|
| 10 | .I Y=-1 K X Q
|
|---|
| 11 | .S X=$P(Y,U,1) W " ",$P(^ONCO(160.4,X,0),U,2)
|
|---|
| 12 | I SCDXDT>2971231 D
|
|---|
| 13 | .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
|
|---|
| 14 | .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
|
|---|
| 15 | .;ROADS D-cxliii
|
|---|
| 16 | .I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
|
|---|
| 17 | .S FOUND=0
|
|---|
| 18 | .F XRR=0:0 S XRR=$O(^ONCO(164,ICD,"RR5",XRR)) Q:XRR'>0!(FOUND=1) D
|
|---|
| 19 | ..I $P(^ONCO(164,ICD,"RR5",XRR,0),U,2)=X S X=XRR,FOUND=1 Q
|
|---|
| 20 | .I FOUND=0 K X Q
|
|---|
| 21 | .W " ",$P(^ONCO(164,ICD,"RR5",X,0),U,1)
|
|---|
| 22 | I $D(X),NTXDD=1 S V=1 D NT^ONCODSR
|
|---|
| 23 | K SCDXDT,FOUND,ICD,TOP,XRR Q
|
|---|
| 24 | ;
|
|---|
| 25 | RROT ;OUTPUT
|
|---|
| 26 | S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
|
|---|
| 27 | I SCDXDT<2980000 D
|
|---|
| 28 | .S:Y'="" Y=$P($G(^ONCO(160.4,Y,0)),U,2)
|
|---|
| 29 | I SCDXDT>2971231 D
|
|---|
| 30 | .Q:Y=""
|
|---|
| 31 | .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
|
|---|
| 32 | .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
|
|---|
| 33 | .;ROADS D-cxliii
|
|---|
| 34 | .I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
|
|---|
| 35 | .S Y=$P($G(^ONCO(164,ICD,"RR5",Y,0)),U,1)
|
|---|
| 36 | K SCDXDT,ICD,TOP Q
|
|---|
| 37 | ;
|
|---|
| 38 | RRHP ;HELP
|
|---|
| 39 | S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
|
|---|
| 40 | I SCDXDT<2980000 D
|
|---|
| 41 | .W !?3,"Select from the following list:"
|
|---|
| 42 | .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)
|
|---|
| 43 | I SCDXDT>2971231 D
|
|---|
| 44 | .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
|
|---|
| 45 | .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
|
|---|
| 46 | .;ROADS D-cxliii
|
|---|
| 47 | .I ($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
|
|---|
| 48 | .W !?3,"Select from the following list:",!
|
|---|
| 49 | .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)
|
|---|
| 50 | K SCDXDT,ICD,TOP,XRR Q
|
|---|
