ONCPST46 ;Hines OIFO/GWB - POST-INSTALL ROUTINE FOR PATCH ONC*2.11*46
;;2.11;ONCOLOGY;**46**;Mar 07, 1995;Build 39
;
S DIE="^VIC(5.1,",DA=1129,DR=".01///MIAMI-DADE" D ^DIE
;
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 TPG=$P($G(^ONCO(165.5,IEN,2)),U,1)
.S MO=$$HIST^ONCFUNC(IEN)
ITEM9 .I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) D
..Q:'$D(^ONCO(165.5,IEN,3.1))
..S:$P(^ONCO(165.5,IEN,3.1),U,29)'="" $P(^ONCO(165.5,IEN,3.1),U,29)=1
..S:$P(^ONCO(165.5,IEN,3.1),U,30)'="" $P(^ONCO(165.5,IEN,3.1),U,30)=1
ITEM14 .S RFNR=$P($G(^ONCO(165.5,IEN,3)),U,35)
.I RFNR=8 S $P(^ONCO(165.5,IEN,3),U,4)=8888888
ITEM15 .S CMX=$P($G(^ONCO(165.5,IEN,3)),U,13)
.I CMX=88 S $P(^ONCO(165.5,IEN,3),U,11)=8888888
.S CMXATF=$P($G(^ONCO(165.5,IEN,3.1)),U,14)
.I CMXATF=88 S $P(^ONCO(165.5,IEN,3.1),U,15)=8888888
.S HTX=$P($G(^ONCO(165.5,IEN,3)),U,16)
.I HTX=88 S $P(^ONCO(165.5,IEN,3),U,14)=8888888
.S HTXATF=$P($G(^ONCO(165.5,IEN,3.1)),U,16)
.I HTXATF=88 S $P(^ONCO(165.5,IEN,3.1),U,17)=8888888
.S IMX=$P($G(^ONCO(165.5,IEN,3)),U,19)
.I IMX=88 S $P(^ONCO(165.5,IEN,3),U,17)=8888888
.S IMXATF=$P($G(^ONCO(165.5,IEN,3.1)),U,18)
.I IMXATF=88 S $P(^ONCO(165.5,IEN,3.1),U,19)=8888888
.S HEMA=""
.S HEMPT=$P($G(^ONCO(165.5,IEN,3.1)),U,36)
.I HEMPT'="" S HEMA=$P(^ONCO(167,HEMPT,0),U,1)
.I HEMA=88 S $P(^ONCO(165.5,IEN,3.1),U,35)=8888888
ITEM20 .I TPG=67422 D
..S SPS=$P($G(^ONCO(165.5,IEN,3.1)),U,29)
..S SPSFAC=$P($G(^ONCO(165.5,IEN,3.1)),U,30)
..I SPS=2 S $P(^ONCO(165.5,IEN,3.1),U,29)=20
..I SPSFAC=3 S $P(^ONCO(165.5,IEN,3.1),U,30)=21
ITEM26 .I ($E(TPG,1,4)=6770)!($E(TPG,1,4)=6771)!($E(TPG,1,4)=6772)!($E(TPG,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(IEN)=1)&($E(TPG,1,4)=6777))!($E(TPG,1,4)=6776)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)!((MO'<97310)&(MO'>99899)) D
..I $P($G(^ONCO(165.5,IEN,3.1)),U,31)=0 S $P(^ONCO(165.5,IEN,3.1),U,31)=9
..I $P($G(^ONCO(165.5,IEN,3.1)),U,32)=0 S $P(^ONCO(165.5,IEN,3.1),U,32)=9
;
MISC6 I $P($G(^VIC(5.1,1129,0)),U,1)="DADE" D
.S DIE="^VIC(5.1,",DA=1129,DR=".01///MIAMI-DADE" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPST46 2166 printed Dec 13, 2024@02:27:32 Page 2
ONCPST46 ;Hines OIFO/GWB - POST-INSTALL ROUTINE FOR PATCH ONC*2.11*46
+1 ;;2.11;ONCOLOGY;**46**;Mar 07, 1995;Build 39
+2 ;
+3 SET DIE="^VIC(5.1,"
SET DA=1129
SET DR=".01///MIAMI-DADE"
DO ^DIE
+4 ;
+5 SET CTR=0
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.5,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+6 SET CTR=CTR+1
IF CTR#100=0
WRITE "."
+7 SET TPG=$PIECE($GET(^ONCO(165.5,IEN,2)),U,1)
+8 SET MO=$$HIST^ONCFUNC(IEN)
ITEM9 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
Begin DoDot:2
+1 if '$DATA(^ONCO(165.5,IEN,3.1))
QUIT
+2 if $PIECE(^ONCO(165.5,IEN,3.1),U,29)'=""
SET $PIECE(^ONCO(165.5,IEN,3.1),U,29)=1
+3 if $PIECE(^ONCO(165.5,IEN,3.1),U,30)'=""
SET $PIECE(^ONCO(165.5,IEN,3.1),U,30)=1
End DoDot:2
ITEM14 SET RFNR=$PIECE($GET(^ONCO(165.5,IEN,3)),U,35)
+1 IF RFNR=8
SET $PIECE(^ONCO(165.5,IEN,3),U,4)=8888888
ITEM15 SET CMX=$PIECE($GET(^ONCO(165.5,IEN,3)),U,13)
+1 IF CMX=88
SET $PIECE(^ONCO(165.5,IEN,3),U,11)=8888888
+2 SET CMXATF=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,14)
+3 IF CMXATF=88
SET $PIECE(^ONCO(165.5,IEN,3.1),U,15)=8888888
+4 SET HTX=$PIECE($GET(^ONCO(165.5,IEN,3)),U,16)
+5 IF HTX=88
SET $PIECE(^ONCO(165.5,IEN,3),U,14)=8888888
+6 SET HTXATF=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,16)
+7 IF HTXATF=88
SET $PIECE(^ONCO(165.5,IEN,3.1),U,17)=8888888
+8 SET IMX=$PIECE($GET(^ONCO(165.5,IEN,3)),U,19)
+9 IF IMX=88
SET $PIECE(^ONCO(165.5,IEN,3),U,17)=8888888
+10 SET IMXATF=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,18)
+11 IF IMXATF=88
SET $PIECE(^ONCO(165.5,IEN,3.1),U,19)=8888888
+12 SET HEMA=""
+13 SET HEMPT=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,36)
+14 IF HEMPT'=""
SET HEMA=$PIECE(^ONCO(167,HEMPT,0),U,1)
+15 IF HEMA=88
SET $PIECE(^ONCO(165.5,IEN,3.1),U,35)=8888888
ITEM20 IF TPG=67422
Begin DoDot:2
+1 SET SPS=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,29)
+2 SET SPSFAC=$PIECE($GET(^ONCO(165.5,IEN,3.1)),U,30)
+3 IF SPS=2
SET $PIECE(^ONCO(165.5,IEN,3.1),U,29)=20
+4 IF SPSFAC=3
SET $PIECE(^ONCO(165.5,IEN,3.1),U,30)=21
End DoDot:2
ITEM26 IF ($EXTRACT(TPG,1,4)=6770)!($EXTRACT(TPG,1,4)=6771)!($EXTRACT(TPG,1,4)=6772)!(...
... $EXTRACT(TPG,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(IEN)=1)&($EXTRACT(TPG,1,4)=6777))!($EXTRACT(TPG,1,4)=6776)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)!((MO'<97310)&(MO'>99899))
Begin DoDot:2
+1 IF $PIECE($GET(^ONCO(165.5,IEN,3.1)),U,31)=0
SET $PIECE(^ONCO(165.5,IEN,3.1),U,31)=9
+2 IF $PIECE($GET(^ONCO(165.5,IEN,3.1)),U,32)=0
SET $PIECE(^ONCO(165.5,IEN,3.1),U,32)=9
End DoDot:2
End DoDot:1
+3 ;
MISC6 IF $PIECE($GET(^VIC(5.1,1129,0)),U,1)="DADE"
Begin DoDot:1
+1 SET DIE="^VIC(5.1,"
SET DA=1129
SET DR=".01///MIAMI-DADE"
DO ^DIE
End DoDot:1
+2 QUIT
