- 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 Feb 19, 2025@00:00:02 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