- 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 Feb 18, 2025@23:54:01 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
