- ONC2PS05 ;Hines OIFO/RTK - Post-Install Routine for Patch ONC*2.2*5 ;09/3/15
- ;;2.2;ONCOLOGY;**5**;Jul 31, 2013;Build 6
- ;
- N RC
- ;NEW Washington DC production server.
- ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:83/cgi_bin/oncsrv.exe")
- ;NEW Washington DC test server, comment out for final release.
- ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
- ;
- D ADDSPS,ADDOSFO,TNMADD,DELOPT,CNVFPST
- K ONC164N,ONCSNAME Q
- ;
- ADDSPS ;Add text to 5TH ED-SURGERY PRIMARY SITE (#111) multiple field-code #15
- ;for entry 67340 (LUNG) of the ICDO TOPOGRAPGY (#164) file
- S ONC164N=$O(^ONCO(164,67340,"SPS","C",15,"")) Q:ONC164N=""
- S DIE="^ONCO(164,67340,""SPS"","
- S DA(1)=67340,DA=ONC164N,ONCSNAME="Local tumor destruction, NOS; RFA"
- S DR=".01///^S X=ONCSNAME" D ^DIE
- K DA,DIE,DR
- Q
- ADDOSFO ;Add new entries to the OTHER STAGING FOR ONCOLOGY (#164.3) file
- I '$D(^ONCO(164.3,"B","BCLC A0")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A0" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC A1")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A1" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC A2")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A2" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC A3")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A3" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC A4")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A4" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC B")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC B" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC C")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC C" D FILE^DICN
- I '$D(^ONCO(164.3,"B","BCLC D")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC D" D FILE^DICN
- I '$D(^ONCO(164.3,"B","UNOS T1")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T1" D FILE^DICN
- I '$D(^ONCO(164.3,"B","UNOS T2")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T2" D FILE^DICN
- I '$D(^ONCO(164.3,"B","UNOS T3")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T3" D FILE^DICN
- I '$D(^ONCO(164.3,"B","UNOS T4a")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T4a" D FILE^DICN
- I '$D(^ONCO(164.3,"B","UNOS T4b")) D
- .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T4b" D FILE^DICN
- Q
- TNMADD ;Add 88 to some T,N,M codes/help text for various entries in
- ;the ICDO TOPOGRAPGY (#164) file
- S ^ONCO(164,67440,11,13,0)="T88 NA"
- S $P(^ONCO(164,67440,11,0),"^",3)=13
- S $P(^ONCO(164,67440,11,0),"^",4)=13
- S ONCNWACT="S ACDANS=$$ADDDXST~ONCACDU1(IEN)" ;set for all 3 extracts
- S DA=405,DA(1)=67440,DIE="^ONCO(164,"_DA(1)_",""N7"","
- S DR="4///^S X=ONCNWACT"
- D ^DIE
- TESTZX9 ;Add 88 entry for 7TH ED N-CODE, 67440 IN (#164) file
- N D0,DA,DD,DIC,X,Y K DD,DO
- Q:$D(^ONCO(164,67440,"N7","B",88))
- S DA(1)=67440,DIC="^ONCO(164,"_DA(1)_",""N7"",",DIC(0)="L"
- F X=88 D FILE^DICN
- Q
- DELOPT ;Delete ONCO ABSTRACT-BRIEF (80c) option from the ONCO ABSTRACT MENU
- S ZZDELO=$$DELETE^XPDMENU("ONCO ABSTRACT MENU","ONCO ABSTRACT-BRIEF 80")
- K ZZDELO
- Q
- CNVFPST ;Convert/correct the FOLLOW-UP STATUS (#160, #15.2) field
- ; First Re-index "AFS" cross-reference on (file #160, field #15.2)
- ;IA #10013 - ENALL2^DIK and ENALL^DIK
- ;IA #10141 - BMES^XPDUTL
- N DIK
- S DIK="^ONCO(160,",DIK(1)="15.2^AFS"
- D BMES^XPDUTL("Re-indexing 'AFS' cross-reference of file #160...")
- D ENALL2^DIK ;Kill existing "AFS" cross-reference.
- D ENALL^DIK ;Re-create "AFS" cross-reference.
- D BMES^XPDUTL("Done Re-indexing the 'AFS' cross-reference...Converting FOLLOW-UP STATUS field...")
- ;
- ;SEARCH FOLLOW-UP SOURCE VALUES FOR PROBLEMS
- S ZZDOTS=0 F ZZFL=0:0 S ZZFL=$O(^ONCO(160,"AFS",ZZFL)) Q:ZZFL'>0 D
- .F ZZPT=0:0 S ZZPT=$O(^ONCO(160,"AFS",ZZFL,ZZPT)) Q:ZZPT'>0 D
- ..;CHECK IF PATIENT HAS SINGLE PRIMARY ONLY & CLASS OF CASE 00 OR 30-99
- ..S ZZPRI=0,ZZPRCNT=0,ZZDOTS=ZZDOTS+1 I ZZDOTS#100=0 W "."
- ..F S ZZPRI=$O(^ONCO(165.5,"C",ZZPT,ZZPRI)) Q:ZZPRI'>0 D
- ...S ZZPRCNT=ZZPRCNT+1
- ..I ZZPRCNT=1 D ; if patient has exactly 1 primary
- ...S ZZPRENT=$O(^ONCO(165.5,"C",ZZPT,0)) Q:ZZPRENT'>0 ; get primary IEN
- ...S ZZPRCOC=$P($G(^ONCO(165.5,ZZPRENT,0)),"^",4) ; get the COC
- ...I ZZPRCOC=1!(ZZPRCOC>9) D
- ....S $P(^ONCO(160,ZZPT,1),"^",7)=0
- ....K ^ONCO(160,"AFS",ZZFL,ZZPT)
- ....S ^ONCO(160,"AFS",0,ZZPT)=""
- K ZZFL,ZZPT,ZZPRI,ZZPRCNT,ZZPRENT,ZZPRCOC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONC2PS05 4231 printed Feb 18, 2025@23:48:08 Page 2
- ONC2PS05 ;Hines OIFO/RTK - Post-Install Routine for Patch ONC*2.2*5 ;09/3/15
- +1 ;;2.2;ONCOLOGY;**5**;Jul 31, 2013;Build 6
- +2 ;
- +3 NEW RC
- +4 ;NEW Washington DC production server.
- +5 ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:83/cgi_bin/oncsrv.exe")
- +6 ;NEW Washington DC test server, comment out for final release.
- +7 ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
- +8 ;
- +9 DO ADDSPS
- DO ADDOSFO
- DO TNMADD
- DO DELOPT
- DO CNVFPST
- +10 KILL ONC164N,ONCSNAME
- QUIT
- +11 ;
- ADDSPS ;Add text to 5TH ED-SURGERY PRIMARY SITE (#111) multiple field-code #15
- +1 ;for entry 67340 (LUNG) of the ICDO TOPOGRAPGY (#164) file
- +2 SET ONC164N=$ORDER(^ONCO(164,67340,"SPS","C",15,""))
- if ONC164N=""
- QUIT
- +3 SET DIE="^ONCO(164,67340,""SPS"","
- +4 SET DA(1)=67340
- SET DA=ONC164N
- SET ONCSNAME="Local tumor destruction, NOS; RFA"
- +5 SET DR=".01///^S X=ONCSNAME"
- DO ^DIE
- +6 KILL DA,DIE,DR
- +7 QUIT
- ADDOSFO ;Add new entries to the OTHER STAGING FOR ONCOLOGY (#164.3) file
- +1 IF '$DATA(^ONCO(164.3,"B","BCLC A0"))
- Begin DoDot:1
- +2 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC A0"
- DO FILE^DICN
- End DoDot:1
- +3 IF '$DATA(^ONCO(164.3,"B","BCLC A1"))
- Begin DoDot:1
- +4 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC A1"
- DO FILE^DICN
- End DoDot:1
- +5 IF '$DATA(^ONCO(164.3,"B","BCLC A2"))
- Begin DoDot:1
- +6 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC A2"
- DO FILE^DICN
- End DoDot:1
- +7 IF '$DATA(^ONCO(164.3,"B","BCLC A3"))
- Begin DoDot:1
- +8 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC A3"
- DO FILE^DICN
- End DoDot:1
- +9 IF '$DATA(^ONCO(164.3,"B","BCLC A4"))
- Begin DoDot:1
- +10 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC A4"
- DO FILE^DICN
- End DoDot:1
- +11 IF '$DATA(^ONCO(164.3,"B","BCLC B"))
- Begin DoDot:1
- +12 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC B"
- DO FILE^DICN
- End DoDot:1
- +13 IF '$DATA(^ONCO(164.3,"B","BCLC C"))
- Begin DoDot:1
- +14 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC C"
- DO FILE^DICN
- End DoDot:1
- +15 IF '$DATA(^ONCO(164.3,"B","BCLC D"))
- Begin DoDot:1
- +16 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="BCLC D"
- DO FILE^DICN
- End DoDot:1
- +17 IF '$DATA(^ONCO(164.3,"B","UNOS T1"))
- Begin DoDot:1
- +18 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="UNOS T1"
- DO FILE^DICN
- End DoDot:1
- +19 IF '$DATA(^ONCO(164.3,"B","UNOS T2"))
- Begin DoDot:1
- +20 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="UNOS T2"
- DO FILE^DICN
- End DoDot:1
- +21 IF '$DATA(^ONCO(164.3,"B","UNOS T3"))
- Begin DoDot:1
- +22 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="UNOS T3"
- DO FILE^DICN
- End DoDot:1
- +23 IF '$DATA(^ONCO(164.3,"B","UNOS T4a"))
- Begin DoDot:1
- +24 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="UNOS T4a"
- DO FILE^DICN
- End DoDot:1
- +25 IF '$DATA(^ONCO(164.3,"B","UNOS T4b"))
- Begin DoDot:1
- +26 SET DIC="^ONCO(164.3,"
- SET DIC(0)="L"
- SET X="UNOS T4b"
- DO FILE^DICN
- End DoDot:1
- +27 QUIT
- TNMADD ;Add 88 to some T,N,M codes/help text for various entries in
- +1 ;the ICDO TOPOGRAPGY (#164) file
- +2 SET ^ONCO(164,67440,11,13,0)="T88 NA"
- +3 SET $PIECE(^ONCO(164,67440,11,0),"^",3)=13
- +4 SET $PIECE(^ONCO(164,67440,11,0),"^",4)=13
- +5 ;set for all 3 extracts
- SET ONCNWACT="S ACDANS=$$ADDDXST~ONCACDU1(IEN)"
- +6 SET DA=405
- SET DA(1)=67440
- SET DIE="^ONCO(164,"_DA(1)_",""N7"","
- +7 SET DR="4///^S X=ONCNWACT"
- +8 DO ^DIE
- TESTZX9 ;Add 88 entry for 7TH ED N-CODE, 67440 IN (#164) file
- +1 NEW D0,DA,DD,DIC,X,Y
- KILL DD,DO
- +2 if $DATA(^ONCO(164,67440,"N7","B",88))
- QUIT
- +3 SET DA(1)=67440
- SET DIC="^ONCO(164,"_DA(1)_",""N7"","
- SET DIC(0)="L"
- +4 FOR X=88
- DO FILE^DICN
- +5 QUIT
- DELOPT ;Delete ONCO ABSTRACT-BRIEF (80c) option from the ONCO ABSTRACT MENU
- +1 SET ZZDELO=$$DELETE^XPDMENU("ONCO ABSTRACT MENU","ONCO ABSTRACT-BRIEF 80")
- +2 KILL ZZDELO
- +3 QUIT
- CNVFPST ;Convert/correct the FOLLOW-UP STATUS (#160, #15.2) field
- +1 ; First Re-index "AFS" cross-reference on (file #160, field #15.2)
- +2 ;IA #10013 - ENALL2^DIK and ENALL^DIK
- +3 ;IA #10141 - BMES^XPDUTL
- +4 NEW DIK
- +5 SET DIK="^ONCO(160,"
- SET DIK(1)="15.2^AFS"
- +6 DO BMES^XPDUTL("Re-indexing 'AFS' cross-reference of file #160...")
- +7 ;Kill existing "AFS" cross-reference.
- DO ENALL2^DIK
- +8 ;Re-create "AFS" cross-reference.
- DO ENALL^DIK
- +9 DO BMES^XPDUTL("Done Re-indexing the 'AFS' cross-reference...Converting FOLLOW-UP STATUS field...")
- +10 ;
- +11 ;SEARCH FOLLOW-UP SOURCE VALUES FOR PROBLEMS
- +12 SET ZZDOTS=0
- FOR ZZFL=0:0
- SET ZZFL=$ORDER(^ONCO(160,"AFS",ZZFL))
- if ZZFL'>0
- QUIT
- Begin DoDot:1
- +13 FOR ZZPT=0:0
- SET ZZPT=$ORDER(^ONCO(160,"AFS",ZZFL,ZZPT))
- if ZZPT'>0
- QUIT
- Begin DoDot:2
- +14 ;CHECK IF PATIENT HAS SINGLE PRIMARY ONLY & CLASS OF CASE 00 OR 30-99
- +15 SET ZZPRI=0
- SET ZZPRCNT=0
- SET ZZDOTS=ZZDOTS+1
- IF ZZDOTS#100=0
- WRITE "."
- +16 FOR
- SET ZZPRI=$ORDER(^ONCO(165.5,"C",ZZPT,ZZPRI))
- if ZZPRI'>0
- QUIT
- Begin DoDot:3
- +17 SET ZZPRCNT=ZZPRCNT+1
- End DoDot:3
- +18 ; if patient has exactly 1 primary
- IF ZZPRCNT=1
- Begin DoDot:3
- +19 ; get primary IEN
- SET ZZPRENT=$ORDER(^ONCO(165.5,"C",ZZPT,0))
- if ZZPRENT'>0
- QUIT
- +20 ; get the COC
- SET ZZPRCOC=$PIECE($GET(^ONCO(165.5,ZZPRENT,0)),"^",4)
- +21 IF ZZPRCOC=1!(ZZPRCOC>9)
- Begin DoDot:4
- +22 SET $PIECE(^ONCO(160,ZZPT,1),"^",7)=0
- +23 KILL ^ONCO(160,"AFS",ZZFL,ZZPT)
- +24 SET ^ONCO(160,"AFS",0,ZZPT)=""
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +25 KILL ZZFL,ZZPT,ZZPRI,ZZPRCNT,ZZPRENT,ZZPRCOC
- +26 QUIT