RAIPS211 ;WOIFO/KLM - Post-init Driver, patch 211 ; Feb 23, 2024@11:23
;;5.0;Radiology/Nuclear Medicine;**211**;Mar 16, 1998;Build 1
;
EN ;entry point
;fall though
BIRADR ;Update the BI-RAD R Code for FDA (Add display text, update name)
N RAIENS,RADX,RAFDA,RAERR,RATXT S RADX=1107
S RAIENS=RADX_","
S RAFDA(78.3,RAIENS,100)="Post-Procedure Mammogram for Marker Placement"
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_" Display text updated"
D BMES^XPDUTL(.RATXT)
;Update .01
S $P(^RA(78.3,RADX,0),U)="BI-RADS CATEGORY R"
;Take care of "B" x-ref
K ^RA(78.3,"B","BI-RADS R",RADX)
S DIK="^RA(78.3,",DA=RADX D IX^DIK
K DA,DIK,RATXT
S RATXT(1)=RADX_" Code name updated"
D BMES^XPDUTL(.RATXT)
;fall through
NOSHOW ;update NO SHOW reason for cancel/hold reason
N RA01,RAIEN,RAIENS,RAFDA,RASCR,RATXT S RA01="PATIENT NO SHOWED"
S RASCR="I $P(^(0),U,5)=""Y""" ;Nat'l flag
S RAIEN=$$FIND1^DIC(75.2,,"X",.RA01,,.RASCR)
I RAIEN>0 S RAIENS=RAIEN_"," D
.K RAERR S RAFDA(75.2,RAIENS,2)=9 ;general request (cancel and hold)
.D FILE^DIE(,"RAFDA","RAERR")
.I $D(RAERR("DIERR")) S RATXT(1)="Error updating Reason "_RA01
.I $G(RATXT(1))="" S RATXT(1)=RA01_" Updated"
.D BMES^XPDUTL(.RATXT)
I RAIEN<1 D
.S RATXT(1)="Error updating Reason "_RA01
.D BMES^XPDUTL(.RATXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS211 1412 printed Oct 16, 2024@18:37 Page 2
RAIPS211 ;WOIFO/KLM - Post-init Driver, patch 211 ; Feb 23, 2024@11:23
+1 ;;5.0;Radiology/Nuclear Medicine;**211**;Mar 16, 1998;Build 1
+2 ;
EN ;entry point
+1 ;fall though
BIRADR ;Update the BI-RAD R Code for FDA (Add display text, update name)
+1 NEW RAIENS,RADX,RAFDA,RAERR,RATXT
SET RADX=1107
+2 SET RAIENS=RADX_","
+3 SET RAFDA(78.3,RAIENS,100)="Post-Procedure Mammogram for Marker Placement"
+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_" Display text updated"
+7 DO BMES^XPDUTL(.RATXT)
+8 ;Update .01
+9 SET $PIECE(^RA(78.3,RADX,0),U)="BI-RADS CATEGORY R"
+10 ;Take care of "B" x-ref
+11 KILL ^RA(78.3,"B","BI-RADS R",RADX)
+12 SET DIK="^RA(78.3,"
SET DA=RADX
DO IX^DIK
+13 KILL DA,DIK,RATXT
+14 SET RATXT(1)=RADX_" Code name updated"
+15 DO BMES^XPDUTL(.RATXT)
+16 ;fall through
NOSHOW ;update NO SHOW reason for cancel/hold reason
+1 NEW RA01,RAIEN,RAIENS,RAFDA,RASCR,RATXT
SET RA01="PATIENT NO SHOWED"
+2 ;Nat'l flag
SET RASCR="I $P(^(0),U,5)=""Y"""
+3 SET RAIEN=$$FIND1^DIC(75.2,,"X",.RA01,,.RASCR)
+4 IF RAIEN>0
SET RAIENS=RAIEN_","
Begin DoDot:1
+5 ;general request (cancel and hold)
KILL RAERR
SET RAFDA(75.2,RAIENS,2)=9
+6 DO FILE^DIE(,"RAFDA","RAERR")
+7 IF $DATA(RAERR("DIERR"))
SET RATXT(1)="Error updating Reason "_RA01
+8 IF $GET(RATXT(1))=""
SET RATXT(1)=RA01_" Updated"
+9 DO BMES^XPDUTL(.RATXT)
End DoDot:1
+10 IF RAIEN<1
Begin DoDot:1
+11 SET RATXT(1)="Error updating Reason "_RA01
+12 DO BMES^XPDUTL(.RATXT)
End DoDot:1
+13 QUIT
