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

RAIPS211.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN ;entry point
  1. ;fall though
  1. BIRADR ;Update the BI-RAD R Code for FDA (Add display text, update name)
  1. N RAIENS,RADX,RAFDA,RAERR,RATXT S RADX=1107
  1. S RAIENS=RADX_","
  1. S RAFDA(78.3,RAIENS,100)="Post-Procedure Mammogram for Marker Placement"
  1. K RAERR D FILE^DIE("E","RAFDA","RAERR")
  1. I $D(RAERR("DIERR")) S RATXT(1)="Error updating BIRAD code "_RADX
  1. I $G(RATXT(1))="" S RATXT(1)=RADX_" Display text updated"
  1. D BMES^XPDUTL(.RATXT)
  1. ;Update .01
  1. S $P(^RA(78.3,RADX,0),U)="BI-RADS CATEGORY R"
  1. ;Take care of "B" x-ref
  1. K ^RA(78.3,"B","BI-RADS R",RADX)
  1. S DIK="^RA(78.3,",DA=RADX D IX^DIK
  1. K DA,DIK,RATXT
  1. S RATXT(1)=RADX_" Code name updated"
  1. D BMES^XPDUTL(.RATXT)
  1. ;fall through
  1. NOSHOW ;update NO SHOW reason for cancel/hold reason
  1. N RA01,RAIEN,RAIENS,RAFDA,RASCR,RATXT S RA01="PATIENT NO SHOWED"
  1. S RASCR="I $P(^(0),U,5)=""Y""" ;Nat'l flag
  1. S RAIEN=$$FIND1^DIC(75.2,,"X",.RA01,,.RASCR)
  1. I RAIEN>0 S RAIENS=RAIEN_"," D
  1. .K RAERR S RAFDA(75.2,RAIENS,2)=9 ;general request (cancel and hold)
  1. .D FILE^DIE(,"RAFDA","RAERR")
  1. .I $D(RAERR("DIERR")) S RATXT(1)="Error updating Reason "_RA01
  1. .I $G(RATXT(1))="" S RATXT(1)=RA01_" Updated"
  1. .D BMES^XPDUTL(.RATXT)
  1. I RAIEN<1 D
  1. .S RATXT(1)="Error updating Reason "_RA01
  1. .D BMES^XPDUTL(.RATXT)
  1. Q