RABIRAD ;HIOFO/SM - BI-RADS processing ; Sep 25, 2023@08:38:32
;;5.0;Radiology/Nuclear Medicine;**97,206**;Mar 16, 1998;Build 8
Q
EN1() ;called from ^DD(78.3,0,"ID","WRITE") node
;p206/KLM - ** Deprecated **display file 78.3's EXPRESSION's external form from file 757.01
;Display file 78.3's DISPLAY TEXT field which replaced the EXPRESSION field.
; IA 1571
; ^(0) is ^RA(78.3,-,0)
N RAX,RAY,RA2
S RA2=$P(^(0),U,2) ;fld 2 description
;S RAX=$$GET1^DIQ(757.01,+$P(^(0),U,6),.01) ;**Deprecated** Ext. expression fld 6
;p206/KLM - EXPRESSION is now in DISPLAY TEXT field 100 (Y defined in FM)
S RAX=$$GET1^DIQ(78.3,Y,100)
I RAX'="" D ;assume field 6 has data only for BIRADS records
.S RAY="("_RAX_")"
.Q
E D ;display Description only for iens 1200 thru 1202
.S RA2=$S((Y>1199)&(Y<1203):RA2,1:"")
.S RAY=$S(RA2="":"",1:"("_RA2_")")
Q RAY
;
CKREQ ; check if case requires at least one BIRAD code
N RA732,RACPT,RAPROC
S RABIREQ=0 ;=0 not require birad, =1 require birad
S RAPROC=$P(RA7003,U,2)
S RACPT=$P(^RAMIS(71,RAPROC,0),U,9)
S RA732=$O(^RA(73.2,"B",RACPT,0)) Q:RA732=""
I $P(^RA(73.2,RA732,0),U,8)="Y",$P(^(0),U,4)="MAMMOGRAPHY",$P(^(0),U,3)="IMAGING" S RABIREQ=1
Q
;
CKDATA ;check if case has any BIRAD data
Q:'RABIREQ
N RAX,RAX2,RAX3
S RABIENS="^" ;string of IENS that are BIRAD codes
S RABIDAT=0 ;=0 no birad data, =1 has birad in either prim. or sec. diag
; find birad iens after ien 1099, look for:
; piece 1 has "BI-RADS CATEGORY" and field 100 has data
S RAX=1099
;p206 - Remove field 6 dependency, use field 100
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_"^"
I RABIENS[("^"_$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)_"^") S RABIDAT=1 Q
S RAX=0
F S RAX=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RAX)) Q:'RAX I RABIENS[("^"_RAX_"^") S RABIDAT=1 Q
I 'RABIDAT D WARN
Q
WARN ;
I RAFIRST W !!?5,"This exam cannot reach the 'COMPLETE' status until a BI-RADS code is entered.",!
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.",!
Q
ASK() ;
S DIR(0)="Y",DIR("A")="Do you want to re-edit diagnostic codes "
S DIR("B")="NO" D ^DIR K DIR
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABIRAD 2378 printed Dec 13, 2024@02:33:46 Page 2
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
+2 QUIT
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
+2 ;Display file 78.3's DISPLAY TEXT field which replaced the EXPRESSION field.
+3 ; IA 1571
+4 ; ^(0) is ^RA(78.3,-,0)
+5 NEW RAX,RAY,RA2
+6 ;fld 2 description
SET RA2=$PIECE(^(0),U,2)
+7 ;S RAX=$$GET1^DIQ(757.01,+$P(^(0),U,6),.01) ;**Deprecated** Ext. expression fld 6
+8 ;p206/KLM - EXPRESSION is now in DISPLAY TEXT field 100 (Y defined in FM)
+9 SET RAX=$$GET1^DIQ(78.3,Y,100)
+10 ;assume field 6 has data only for BIRADS records
IF RAX'=""
Begin DoDot:1
+11 SET RAY="("_RAX_")"
+12 QUIT
End DoDot:1
+13 ;display Description only for iens 1200 thru 1202
IF '$TEST
Begin DoDot:1
+14 SET RA2=$SELECT((Y>1199)&(Y<1203):RA2,1:"")
+15 SET RAY=$SELECT(RA2="":"",1:"("_RA2_")")
End DoDot:1
+16 QUIT RAY
+17 ;
CKREQ ; check if case requires at least one BIRAD code
+1 NEW RA732,RACPT,RAPROC
+2 ;=0 not require birad, =1 require birad
SET RABIREQ=0
+3 SET RAPROC=$PIECE(RA7003,U,2)
+4 SET RACPT=$PIECE(^RAMIS(71,RAPROC,0),U,9)
+5 SET RA732=$ORDER(^RA(73.2,"B",RACPT,0))
if RA732=""
QUIT
+6 IF $PIECE(^RA(73.2,RA732,0),U,8)="Y"
IF $PIECE(^(0),U,4)="MAMMOGRAPHY"
IF $PIECE(^(0),U,3)="IMAGING"
SET RABIREQ=1
+7 QUIT
+8 ;
CKDATA ;check if case has any BIRAD data
+1 if 'RABIREQ
QUIT
+2 NEW RAX,RAX2,RAX3
+3 ;string of IENS that are BIRAD codes
SET RABIENS="^"
+4 ;=0 no birad data, =1 has birad in either prim. or sec. diag
SET RABIDAT=0
+5 ; find birad iens after ien 1099, look for:
+6 ; piece 1 has "BI-RADS CATEGORY" and field 100 has data
+7 SET RAX=1099
+8 ;p206 - Remove field 6 dependency, use field 100
+9 FOR
SET RAX=$ORDER(^RA(78.3,RAX))
if 'RAX
QUIT
SET RAX2=$GET(^(RAX,0))
SET RAX3=$GET(^RA(78.3,RAX,1))
IF $PIECE(RAX2,U)["BI-RADS CATEGORY"
IF RAX3]""
SET RABIENS=RABIENS_RAX_"^"
+10 IF RABIENS[("^"_$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)_"^")
SET RABIDAT=1
QUIT
+11 SET RAX=0
+12 FOR
SET RAX=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RAX))
if 'RAX
QUIT
IF RABIENS[("^"_RAX_"^")
SET RABIDAT=1
QUIT
+13 IF 'RABIDAT
DO WARN
+14 QUIT
WARN ;
+1 IF RAFIRST
WRITE !!?5,"This exam cannot reach the 'COMPLETE' status until a BI-RADS code is entered.",!
+2 IF '$TEST
WRITE !!?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.",!
+3 QUIT
ASK() ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to re-edit diagnostic codes "
+2 SET DIR("B")="NO"
DO ^DIR
KILL DIR
+3 QUIT Y
