Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONC2PS05

ONC2PS05.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. N RC
  1. ;NEW Washington DC production server.
  1. ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:83/cgi_bin/oncsrv.exe")
  1. ;NEW Washington DC test server, comment out for final release.
  1. ;S RC=$$UPDCSURL^ONCSAPIU("http://127.0.0.1:81/cgi_bin/oncsrv.exe")
  1. ;
  1. D ADDSPS,ADDOSFO,TNMADD,DELOPT,CNVFPST
  1. K ONC164N,ONCSNAME Q
  1. ;
  1. 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
  1. S ONC164N=$O(^ONCO(164,67340,"SPS","C",15,"")) Q:ONC164N=""
  1. S DIE="^ONCO(164,67340,""SPS"","
  1. S DA(1)=67340,DA=ONC164N,ONCSNAME="Local tumor destruction, NOS; RFA"
  1. S DR=".01///^S X=ONCSNAME" D ^DIE
  1. K DA,DIE,DR
  1. Q
  1. ADDOSFO ;Add new entries to the OTHER STAGING FOR ONCOLOGY (#164.3) file
  1. I '$D(^ONCO(164.3,"B","BCLC A0")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A0" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC A1")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A1" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC A2")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A2" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC A3")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A3" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC A4")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC A4" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC B")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC B" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC C")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC C" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","BCLC D")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="BCLC D" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","UNOS T1")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T1" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","UNOS T2")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T2" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","UNOS T3")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T3" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","UNOS T4a")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T4a" D FILE^DICN
  1. I '$D(^ONCO(164.3,"B","UNOS T4b")) D
  1. .S DIC="^ONCO(164.3,",DIC(0)="L",X="UNOS T4b" D FILE^DICN
  1. Q
  1. TNMADD ;Add 88 to some T,N,M codes/help text for various entries in
  1. ;the ICDO TOPOGRAPGY (#164) file
  1. S ^ONCO(164,67440,11,13,0)="T88 NA"
  1. S $P(^ONCO(164,67440,11,0),"^",3)=13
  1. S $P(^ONCO(164,67440,11,0),"^",4)=13
  1. S ONCNWACT="S ACDANS=$$ADDDXST~ONCACDU1(IEN)" ;set for all 3 extracts
  1. S DA=405,DA(1)=67440,DIE="^ONCO(164,"_DA(1)_",""N7"","
  1. S DR="4///^S X=ONCNWACT"
  1. D ^DIE
  1. TESTZX9 ;Add 88 entry for 7TH ED N-CODE, 67440 IN (#164) file
  1. N D0,DA,DD,DIC,X,Y K DD,DO
  1. Q:$D(^ONCO(164,67440,"N7","B",88))
  1. S DA(1)=67440,DIC="^ONCO(164,"_DA(1)_",""N7"",",DIC(0)="L"
  1. F X=88 D FILE^DICN
  1. Q
  1. DELOPT ;Delete ONCO ABSTRACT-BRIEF (80c) option from the ONCO ABSTRACT MENU
  1. S ZZDELO=$$DELETE^XPDMENU("ONCO ABSTRACT MENU","ONCO ABSTRACT-BRIEF 80")
  1. K ZZDELO
  1. Q
  1. CNVFPST ;Convert/correct the FOLLOW-UP STATUS (#160, #15.2) field
  1. ; First Re-index "AFS" cross-reference on (file #160, field #15.2)
  1. ;IA #10013 - ENALL2^DIK and ENALL^DIK
  1. ;IA #10141 - BMES^XPDUTL
  1. N DIK
  1. S DIK="^ONCO(160,",DIK(1)="15.2^AFS"
  1. D BMES^XPDUTL("Re-indexing 'AFS' cross-reference of file #160...")
  1. D ENALL2^DIK ;Kill existing "AFS" cross-reference.
  1. D ENALL^DIK ;Re-create "AFS" cross-reference.
  1. D BMES^XPDUTL("Done Re-indexing the 'AFS' cross-reference...Converting FOLLOW-UP STATUS field...")
  1. ;
  1. ;SEARCH FOLLOW-UP SOURCE VALUES FOR PROBLEMS
  1. S ZZDOTS=0 F ZZFL=0:0 S ZZFL=$O(^ONCO(160,"AFS",ZZFL)) Q:ZZFL'>0 D
  1. .F ZZPT=0:0 S ZZPT=$O(^ONCO(160,"AFS",ZZFL,ZZPT)) Q:ZZPT'>0 D
  1. ..;CHECK IF PATIENT HAS SINGLE PRIMARY ONLY & CLASS OF CASE 00 OR 30-99
  1. ..S ZZPRI=0,ZZPRCNT=0,ZZDOTS=ZZDOTS+1 I ZZDOTS#100=0 W "."
  1. ..F S ZZPRI=$O(^ONCO(165.5,"C",ZZPT,ZZPRI)) Q:ZZPRI'>0 D
  1. ...S ZZPRCNT=ZZPRCNT+1
  1. ..I ZZPRCNT=1 D ; if patient has exactly 1 primary
  1. ...S ZZPRENT=$O(^ONCO(165.5,"C",ZZPT,0)) Q:ZZPRENT'>0 ; get primary IEN
  1. ...S ZZPRCOC=$P($G(^ONCO(165.5,ZZPRENT,0)),"^",4) ; get the COC
  1. ...I ZZPRCOC=1!(ZZPRCOC>9) D
  1. ....S $P(^ONCO(160,ZZPT,1),"^",7)=0
  1. ....K ^ONCO(160,"AFS",ZZFL,ZZPT)
  1. ....S ^ONCO(160,"AFS",0,ZZPT)=""
  1. K ZZFL,ZZPT,ZZPRI,ZZPRCNT,ZZPRENT,ZZPRCOC
  1. Q