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

RABIRAD.m

Go to the documentation of this file.
  1. RABIRAD ;HIOFO/SM - BI-RADS processing ; Sep 25, 2023@08:38:32
  1. ;;5.0;Radiology/Nuclear Medicine;**97,206**;Mar 16, 1998;Build 8
  1. Q
  1. EN1() ;called from ^DD(78.3,0,"ID","WRITE") node
  1. ;p206/KLM - ** Deprecated **display file 78.3's EXPRESSION's external form from file 757.01
  1. ;Display file 78.3's DISPLAY TEXT field which replaced the EXPRESSION field.
  1. ; IA 1571
  1. ; ^(0) is ^RA(78.3,-,0)
  1. N RAX,RAY,RA2
  1. S RA2=$P(^(0),U,2) ;fld 2 description
  1. ;S RAX=$$GET1^DIQ(757.01,+$P(^(0),U,6),.01) ;**Deprecated** Ext. expression fld 6
  1. ;p206/KLM - EXPRESSION is now in DISPLAY TEXT field 100 (Y defined in FM)
  1. S RAX=$$GET1^DIQ(78.3,Y,100)
  1. I RAX'="" D ;assume field 6 has data only for BIRADS records
  1. .S RAY="("_RAX_")"
  1. .Q
  1. E D ;display Description only for iens 1200 thru 1202
  1. .S RA2=$S((Y>1199)&(Y<1203):RA2,1:"")
  1. .S RAY=$S(RA2="":"",1:"("_RA2_")")
  1. Q RAY
  1. ;
  1. CKREQ ; check if case requires at least one BIRAD code
  1. N RA732,RACPT,RAPROC
  1. S RABIREQ=0 ;=0 not require birad, =1 require birad
  1. S RAPROC=$P(RA7003,U,2)
  1. S RACPT=$P(^RAMIS(71,RAPROC,0),U,9)
  1. S RA732=$O(^RA(73.2,"B",RACPT,0)) Q:RA732=""
  1. I $P(^RA(73.2,RA732,0),U,8)="Y",$P(^(0),U,4)="MAMMOGRAPHY",$P(^(0),U,3)="IMAGING" S RABIREQ=1
  1. Q
  1. ;
  1. CKDATA ;check if case has any BIRAD data
  1. Q:'RABIREQ
  1. N RAX,RAX2,RAX3
  1. S RABIENS="^" ;string of IENS that are BIRAD codes
  1. S RABIDAT=0 ;=0 no birad data, =1 has birad in either prim. or sec. diag
  1. ; find birad iens after ien 1099, look for:
  1. ; piece 1 has "BI-RADS CATEGORY" and field 100 has data
  1. S RAX=1099
  1. ;p206 - Remove field 6 dependency, use field 100
  1. F S RAX=$O(^RA(78.3,RAX)) Q:'RAX S RAX2=$G(^(RAX,0)),RAX3=$G(^RA(78.3,RAX,1)) I $P(RAX2,U)["BI-RADS CATEGORY",RAX3]"" S RABIENS=RABIENS_RAX_"^"
  1. I RABIENS[("^"_$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)_"^") S RABIDAT=1 Q
  1. S RAX=0
  1. F S RAX=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RAX)) Q:'RAX I RABIENS[("^"_RAX_"^") S RABIDAT=1 Q
  1. I 'RABIDAT D WARN
  1. Q
  1. WARN ;
  1. I RAFIRST W !!?5,"This exam cannot reach the 'COMPLETE' status until a BI-RADS code is entered.",!
  1. E W !!?5,"This case requires a BI-RADS code. It either had a BI-RADS code ",!?5,"that was deleted or never had one. Please use this option to ",!?5,"re-enter a BI-RADS code.",!
  1. Q
  1. ASK() ;
  1. S DIR(0)="Y",DIR("A")="Do you want to re-edit diagnostic codes "
  1. S DIR("B")="NO" D ^DIR K DIR
  1. Q Y