ONCPST44 ;Hines OIFO/GWB - Post-init for Patch ONC*2.11*44
;;2.11;ONCOLOGY;**44**; Mar 07, 1995
;
;Split LUNG cases into LUNG, NON-SMALL CELL and LUNG, SMALL CELL
;
;Split RECTUM/ANUS cases into RECTUM and ANUS
;
;Convert melanoma cases to MELANOMA
;
;Convert RADIATIION/SURGERY SEQUENCE (165.5,51.3)
;
;Correct COUNTY DX (165.5,10) and COMORBIDITY/COMPLICATION #1-6
;(160,25-25.5) upload problems
;
S CTR=0 F IEN=0:0 S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
.S CTR=CTR+1 I CTR#100=0 W "."
.S SITE=$$GET1^DIQ(165.5,IEN,.01)
.S HIST=$P($G(^ONCO(165.5,IEN,2.2)),U,3)
.S PS=$P($G(^ONCO(165.5,IEN,2)),U,1)
.I SITE["LUNG" D
..I ($E(HIST,1,4)=8041)!($E(HIST,1,4)=8042)!($E(HIST,1,4)=8043)!($E(HIST,1,4)=8044)!($E(HIST,1,4)=8045)!($E(HIST,1,4)=8246) D
...S DIE="^ONCO(165.5,",DA=IEN,DR=".01///LUNG SMALL CELL" D ^DIE
.I $$MELANOMA^ONCOU55(IEN) D
..S DIE="^ONCO(165.5,",DA=IEN,DR=".01///MELANOMA" D ^DIE
.S S=$E($$GET1^DIQ(165.5,IEN,58.6,"E"),1,2)
.S SATF=$E($$GET1^DIQ(165.5,IEN,58.7,"E"),1,2)
.S SCP=$P($G(^ONCO(165.5,IEN,3.1)),U,31)
.S SCPATF=$P($G(^ONCO(165.5,IEN,3.1)),U,32)
.S SOTH=$P($G(^ONCO(165.5,IEN,3.1)),U,33)
.S SOTHATF=$P($G(^ONCO(165.5,IEN,3.1)),U,34)
.I $E(PS,3,4)=21 D
..S DIE="^ONCO(165.5,",DA=IEN,DR=".01///ANUS" D ^DIE
.I ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF="")) D
..I $P($G(^ONCO(165.5,IEN,3)),U,7)'="" S $P(^ONCO(165.5,IEN,3),U,7)=0
.I $D(^ONCO(165.5,"UPL")) D
..S PATPNT=$P($G(^ONCO(165.5,IEN,0)),U,2)
..K CC
..S CC1=$P($G(^ONCO(160,PATPNT,0)),U,19)
..S CC2=$P($G(^ONCO(160,PATPNT,0)),U,20)
..S CC3=$P($G(^ONCO(160,PATPNT,0)),U,21)
..S CC4=$P($G(^ONCO(160,PATPNT,0)),U,22)
..S CC5=$P($G(^ONCO(160,PATPNT,0)),U,23)
..S CC6=$P($G(^ONCO(160,PATPNT,0)),U,24)
..S:CC1'="" CC(CC1)=""
..S:CC2'="" CC(CC2)=""
..S:CC3'="" CC(CC3)=""
..S:CC4'="" CC(CC4)=""
..S:CC5'="" CC(CC5)=""
..S:CC6'="" CC(CC6)=""
..I '$D(CC) Q
..F PIECE=19:1:24 S $P(^ONCO(160,PATPNT,0),U,PIECE)=""
..S CCPNT=0 F PIECE=19:1 S CCPNT=$O(CC(CCPNT)) Q:CCPNT="" S $P(^ONCO(160,PATPNT,0),U,PIECE)=CCPNT
.
.S CTDX=$P($G(^ONCO(165.5,IEN,1)),U,3)
.I CTDX="" Q
.S STDX=$P($G(^ONCO(165.5,IEN,1)),U,4)
.I STDX="" Q
.S CTNAME=$P($G(^VIC(5.1,CTDX,0)),U,1)
.S CTSTAT=$P($G(^VIC(5.1,CTDX,0)),U,2)
.I CTSTAT="" Q
.S CTSTABR=$P($G(^DIC(5,CTSTAT,0)),U,2)
.I CTSTABR="FG" Q
.S STSTABR=$P($G(^ONCO(160.15,STDX,0)),U,1)
.I CTSTABR'=STSTABR D
..S VICIEN=0 F S VICIEN=$O(^VIC(5.1,"B",CTNAME,VICIEN)) Q:VICIEN'>0 S VICSTPT=$P($G(^VIC(5.1,VICIEN,0)),U,2),DICSTABR=$P($G(^DIC(5,VICSTPT,0)),U,2) I DICSTABR=STSTABR S $P(^ONCO(165.5,IEN,1),U,3)=VICIEN Q
;
;Delete ICDO-1 TOPOGRAPHY (164.22,.02) Data Dictionary and data
S DIK="^DD(164.22,",DA=.02,DA(1)=164.22 D ^DIK
F IEN=0:0 S IEN=$O(^ONCO(164.2,IEN)) Q:IEN'>0 D
.F SUBIEN=0:0 S SUBIEN=$O(^ONCO(164.2,IEN,"T",SUBIEN)) Q:SUBIEN'>0 S TOP=$P(^ONCO(164.2,IEN,"T",SUBIEN,0),U,1) S ^ONCO(164.2,IEN,"T",SUBIEN,0)=TOP
K ^ONCO(164.2,"G")
;
;Delete ^ONCO(160.2,5) = WORK-SHEET
K DA,DIK S DIK="^ONCO(160.2,",DA=5 D ^DIK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPST44 3206 printed Dec 13, 2024@02:27:30 Page 2
ONCPST44 ;Hines OIFO/GWB - Post-init for Patch ONC*2.11*44
+1 ;;2.11;ONCOLOGY;**44**; Mar 07, 1995
+2 ;
+3 ;Split LUNG cases into LUNG, NON-SMALL CELL and LUNG, SMALL CELL
+4 ;
+5 ;Split RECTUM/ANUS cases into RECTUM and ANUS
+6 ;
+7 ;Convert melanoma cases to MELANOMA
+8 ;
+9 ;Convert RADIATIION/SURGERY SEQUENCE (165.5,51.3)
+10 ;
+11 ;Correct COUNTY DX (165.5,10) and COMORBIDITY/COMPLICATION #1-6
+12 ;(160,25-25.5) upload problems
+13 ;
+14 SET CTR=0
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.5,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+15 SET CTR=CTR+1
IF CTR#100=0
WRITE "."
+16 SET SITE=$$GET1^DIQ(165.5,IEN,.01)
+17 SET HIST=$PIECE($GET(^ONCO(165.5,IEN,2.2)),U,3)
+18 SET PS=$PIECE($GET(^ONCO(165.5,IEN,2)),U,1)
+19 IF SITE["LUNG"
Begin DoDot:2
+20 IF ($EXTRACT(HIST,1,4)=8041)!($EXTRACT(HIST,1,4)=8042)!($EXTRACT(HIST,1,4)=8043)!($EXTRACT(HIST,1,4)=8044)!($EXTRACT(HIST,1,4)=8045)!($EXTRACT(HIST,1,4)=8246)
Begin DoDot:3
+21 SET DIE="^ONCO(165.5,"
SET DA=IEN
SET DR=".01///LUNG SMALL CELL"
DO ^DIE
End DoDot:3
End DoDot:2
+22 IF $$MELANOMA^ONCOU55(IEN)
Begin DoDot:2
+23 SET DIE="^ONCO(165.5,"
SET DA=IEN
SET DR=".01///MELANOMA"
DO ^DIE
End DoDot:2
+24 SET S=$EXTRACT($$GET1^DIQ(165.5,IEN,58.6,"E"),1,2)
+25 SET SATF=$EXTRACT($$GET1^DIQ(165.5,IEN,58.7,"E"),1,2)
+26 SET SCP=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,31)
+27 SET SCPATF=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,32)
+28 SET SOTH=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,33)
+29 SET SOTHATF=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,34)
+30 IF $EXTRACT(PS,3,4)=21
Begin DoDot:2
+31 SET DIE="^ONCO(165.5,"
SET DA=IEN
SET DR=".01///ANUS"
DO ^DIE
End DoDot:2
+32 IF ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF=""))
Begin DoDot:2
+33 IF $PIECE($GET(^ONCO(165.5,IEN,3)),U,7)'=""
SET $PIECE(^ONCO(165.5,IEN,3),U,7)=0
End DoDot:2
+34 IF $DATA(^ONCO(165.5,"UPL"))
Begin DoDot:2
+35 SET PATPNT=$PIECE($GET(^ONCO(165.5,IEN,0)),U,2)
+36 KILL CC
+37 SET CC1=$PIECE($GET(^ONCO(160,PATPNT,0)),U,19)
+38 SET CC2=$PIECE($GET(^ONCO(160,PATPNT,0)),U,20)
+39 SET CC3=$PIECE($GET(^ONCO(160,PATPNT,0)),U,21)
+40 SET CC4=$PIECE($GET(^ONCO(160,PATPNT,0)),U,22)
+41 SET CC5=$PIECE($GET(^ONCO(160,PATPNT,0)),U,23)
+42 SET CC6=$PIECE($GET(^ONCO(160,PATPNT,0)),U,24)
+43 if CC1'=""
SET CC(CC1)=""
+44 if CC2'=""
SET CC(CC2)=""
+45 if CC3'=""
SET CC(CC3)=""
+46 if CC4'=""
SET CC(CC4)=""
+47 if CC5'=""
SET CC(CC5)=""
+48 if CC6'=""
SET CC(CC6)=""
+49 IF '$DATA(CC)
QUIT
+50 FOR PIECE=19:1:24
SET $PIECE(^ONCO(160,PATPNT,0),U,PIECE)=""
+51 SET CCPNT=0
FOR PIECE=19:1
SET CCPNT=$ORDER(CC(CCPNT))
if CCPNT=""
QUIT
SET $PIECE(^ONCO(160,PATPNT,0),U,PIECE)=CCPNT
End DoDot:2
+52 +53 SET CTDX=$PIECE($GET(^ONCO(165.5,IEN,1)),U,3)
+54 IF CTDX=""
QUIT
+55 SET STDX=$PIECE($GET(^ONCO(165.5,IEN,1)),U,4)
+56 IF STDX=""
QUIT
+57 SET CTNAME=$PIECE($GET(^VIC(5.1,CTDX,0)),U,1)
+58 SET CTSTAT=$PIECE($GET(^VIC(5.1,CTDX,0)),U,2)
+59 IF CTSTAT=""
QUIT
+60 SET CTSTABR=$PIECE($GET(^DIC(5,CTSTAT,0)),U,2)
+61 IF CTSTABR="FG"
QUIT
+62 SET STSTABR=$PIECE($GET(^ONCO(160.15,STDX,0)),U,1)
+63 IF CTSTABR'=STSTABR
Begin DoDot:2
+64 SET VICIEN=0
FOR
SET VICIEN=$ORDER(^VIC(5.1,"B",CTNAME,VICIEN))
if VICIEN'>0
QUIT
SET VICSTPT=$PIECE($GET(^VIC(5.1,VICIEN,0)),U,2)
SET DICSTABR=$PIECE($GET(^DIC(5,VICSTPT,0)),U,2)
IF DICSTABR=STSTABR
SET $PIECE(^ONCO(165.5,IEN,1),U,3)=VICIEN
QUIT
End DoDot:2
End DoDot:1
+65 ;
+66 ;Delete ICDO-1 TOPOGRAPHY (164.22,.02) Data Dictionary and data
+67 SET DIK="^DD(164.22,"
SET DA=.02
SET DA(1)=164.22
DO ^DIK
+68 FOR IEN=0:0
SET IEN=$ORDER(^ONCO(164.2,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+69 FOR SUBIEN=0:0
SET SUBIEN=$ORDER(^ONCO(164.2,IEN,"T",SUBIEN))
if SUBIEN'>0
QUIT
SET TOP=$PIECE(^ONCO(164.2,IEN,"T",SUBIEN,0),U,1)
SET ^ONCO(164.2,IEN,"T",SUBIEN,0)=TOP
End DoDot:1
+70 KILL ^ONCO(164.2,"G")
+71 ;
+72 ;Delete ^ONCO(160.2,5) = WORK-SHEET
+73 KILL DA,DIK
SET DIK="^ONCO(160.2,"
SET DA=5
DO ^DIK
