RAIPS206.m

RAIPS206 ;WOIFO/KLM - Post-init Driver, patch 206 ; Sep 26, 2023@09:50:23

 ;;5.0;Radiology/Nuclear Medicine;**206**;Mar 16, 1998;Build 8

 ;

 ;Supported IA #1571 ^LEX(757.01

 ;

BIRADS ;updates to BIRADS

 ;Add New codes

 N RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA2,RA3,RA4,RAMSG

 F RAI=1:1 S RADX=$T(CODES+RAI) Q:RADX=""  D

 .S RA001=$P($P(RADX,";",3),"^"),RA01=$P($P(RADX,";",3),"^",2),RA2=$P($P(RADX,";",3),"^",3),RA3=$P($P(RADX,";",3),"^",4),RA4=$P($P(RADX,";",3),"^",5)

 .Q:RA001=""

 .S RAFDA(78.3,"+1,",.01)=RA01 ; DIAG CODE

 .S RAFDA(78.3,"+1,",2)=RA2   ; DIAG DESC

 .S RAFDA(78.3,"+1,",3)=RA3   ; PRINT ON ABN REPORT

 .S RAFDA(78.3,"+1,",4)=RA4   ; GENERATE ALERT

 .S:RA001=1110 RAFDA(78.3,"+1,",100)="Incomplete: Need prior mammograms for comparison" ;DISPLAY TEXT

 .S RADNUM(1)=RA001

 .D UPDATE^DIE("","RAFDA","RADNUM","RAMSG")

 .;Capture any "DIERR" messages - they will tell us if an IEN already existed.  They shouldn't but you never know.

 .I $D(RAMSG("DIERR")) D

 ..S RATXT(1)="Error filing BI-RADS code "_RA001 D BMES^XPDUTL(.RATXT)

 ..Q

 .Q

 ;

ABN ;Set "Print on Abnormal Report" field for 1101 and 1102

 N RAIENS,RADX F RADX=1101,1102 D

 .S RAIENS=RADX_","

 .S RAFDA(78.3,RAIENS,3)="Y"   ; PRINT ON ABN REPORT

 .K RAERR D FILE^DIE("E","RAFDA","RAERR")

 .I $D(RAERR("DIERR")) S RATXT(1)="Error updating BIRAD code "_RADX

 .I $G(RATXT(1))="" S RATXT(1)=RADX_" Updated"

 .D BMES^XPDUTL(.RATXT)

 .K RAERR,RATXT

 .Q

 ;

EXP ;Expression field update (data type changed from 757.01 pointer to free text).

 N RADX,RAEXP

 F RADX=1100:1:1106 D

 .S RAEXP=$P(^RA(78.3,RADX,0),U,6) Q:$G(RAEXP)=""!($G(RAEXP)'?2N)

 .S $P(^RA(78.3,RADX,1),U)=$$GET1^DIQ(757.01,RAEXP,.01)

 .Q

 Q

CODES ; NUMBER^CODE^DESC^PRINT^ALERT

 ;;1107^BI-RADS R^Post-Procedure Mammogram for Marker Placement^Y^n

 ;;1110^BI-RADS CATEGORY 0^Incomplete: Need Prior Mammograms for Comparison^Y^y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RAIPS206   1902     printed  Feb 19, 2025@00:02:39                                                                                                                                                                                                    Page 2

RAIPS206  ;WOIFO/KLM - Post-init Driver, patch 206 ; Sep 26, 2023@09:50:23

 +1       ;;5.0;Radiology/Nuclear Medicine;**206**;Mar 16, 1998;Build 8

 +2       ;

 +3       ;Supported IA #1571 ^LEX(757.01

 +4       ;

BIRADS    ;updates to BIRADS

 +1       ;Add New codes

 +2        NEW RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA2,RA3,RA4,RAMSG

 +3        FOR RAI=1:1

               SET RADX=$TEXT(CODES+RAI)

               if RADX=""

                   QUIT 

               Begin DoDot:1

 +4                SET RA001=$PIECE($PIECE(RADX,";",3),"^")

                   SET RA01=$PIECE($PIECE(RADX,";",3),"^",2)

                   SET RA2=$PIECE($PIECE(RADX,";",3),"^",3)

                   SET RA3=$PIECE($PIECE(RADX,";",3),"^",4)

                   SET RA4=$PIECE($PIECE(RADX,";",3),"^",5)

 +5                if RA001=""

                       QUIT 

 +6       ; DIAG CODE

                   SET RAFDA(78.3,"+1,",.01)=RA01

 +7       ; DIAG DESC

                   SET RAFDA(78.3,"+1,",2)=RA2

 +8       ; PRINT ON ABN REPORT

                   SET RAFDA(78.3,"+1,",3)=RA3

 +9       ; GENERATE ALERT

                   SET RAFDA(78.3,"+1,",4)=RA4

 +10      ;DISPLAY TEXT

                   if RA001=1110

                       SET RAFDA(78.3,"+1,",100)="Incomplete: Need prior mammograms for comparison"

 +11               SET RADNUM(1)=RA001

 +12               DO UPDATE^DIE("","RAFDA","RADNUM","RAMSG")

 +13      ;Capture any "DIERR" messages - they will tell us if an IEN already existed.  They shouldn't but you never know.

 +14               IF $DATA(RAMSG("DIERR"))

                       Begin DoDot:2

 +15                       SET RATXT(1)="Error filing BI-RADS code "_RA001

                           DO BMES^XPDUTL(.RATXT)

 +16                       QUIT 

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18      ;

ABN       ;Set "Print on Abnormal Report" field for 1101 and 1102

 +1        NEW RAIENS,RADX

           FOR RADX=1101,1102

               Begin DoDot:1

 +2                SET RAIENS=RADX_","

 +3       ; PRINT ON ABN REPORT

                   SET RAFDA(78.3,RAIENS,3)="Y"

 +4                KILL RAERR

                   DO FILE^DIE("E","RAFDA","RAERR")

 +5                IF $DATA(RAERR("DIERR"))

                       SET RATXT(1)="Error updating BIRAD code "_RADX

 +6                IF $GET(RATXT(1))=""

                       SET RATXT(1)=RADX_" Updated"

 +7                DO BMES^XPDUTL(.RATXT)

 +8                KILL RAERR,RATXT

 +9                QUIT 

               End DoDot:1

 +10      ;

EXP       ;Expression field update (data type changed from 757.01 pointer to free text).

 +1        NEW RADX,RAEXP

 +2        FOR RADX=1100:1:1106

               Begin DoDot:1

 +3                SET RAEXP=$PIECE(^RA(78.3,RADX,0),U,6)

                   if $GET(RAEXP)=""!($GET(RAEXP)'?2N)

                       QUIT 

 +4                SET $PIECE(^RA(78.3,RADX,1),U)=$$GET1^DIQ(757.01,RAEXP,.01)

 +5                QUIT 

               End DoDot:1

 +6        QUIT 

CODES     ; NUMBER^CODE^DESC^PRINT^ALERT

 +1       ;;1107^BI-RADS R^Post-Procedure Mammogram for Marker Placement^Y^n

 +2       ;;1110^BI-RADS CATEGORY 0^Incomplete: Need Prior Mammograms for Comparison^Y^y