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

RAEDCN1.m

Go to the documentation of this file. 
  1. RAEDCN1 ;HISC/GJC-Utility routine for RAEDCN ; 20 Apr 2011  7:26 PM
  1.  ;;5.0;Radiology/Nuclear Medicine;**18,45,93,1003**;Nov 01, 2010;Build 3
  1.  ; last modif by SS for P18
  1.  ; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
  1. UNDEF ; Message for undefined imaging types
  1.  I '+$G(RAMLC) D  Q
  1.  . W !?5,"Imaging Location data is not defined, "
  1.  . W "contact IRM.",$C(7)
  1.  . Q
  1.  W !?5,"An Imaging Type was not defined for the following Imaging"
  1.  W !?5,"Location: "_$P(^SC($P($G(^RA(79.1,+RAMLC,0)),U),0),U)_"."
  1.  Q
  1. STUB(RARPT) ; Determine if this is an imaging stub report.
  1.  ; Input: RARPT-ien of the report record
  1.  ; Output: 1 if an imaging stub rpt, else 0
  1.  N RA0 S RA0=$O(^RARPT(RARPT,"L",""),-1) ; most recent activity on rpt
  1.  I RA0>0,$P($G(^RARPT(RARPT,"L",RA0,0)),U,2)="C",$P(^RARPT(RARPT,0),U,5)="",$O(^RARPT(RARPT,2005,0)),'$D(^RARPT(RARPT,"I")),'$D(^("P")),'$D(^("R")) Q 1 ; rpt is an image stub
  1.  Q 0 ; (non-stub rpt record)
  1.  ;
  1. PSET(RADFN,RADTI,RACNI) ; Determine if this exam is part of a printset.
  1.  ; Input: RADFN-patient dfn <-> RADTI-exam timestamp <-> RACNI-exam ien
  1.  ; Output: 1 if part of a printset, else 0
  1.  Q $S($P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2:1,1:0)
  1.  ;
  1. CKREASON(X) ;check file 75.2 ; P18 moved it from RAEDCN because the routine's length exceeded limit
  1.  ; 0=OKAY, 1=BAD
  1.  ; don't check for var RAOREA, because it's not set this early
  1.  I X="C",$O(^RA(75.2,"B","EXAM CANCELLED",0)) Q 0
  1.  I X="D",$O(^RA(75.2,"B","EXAM DELETED",0)) Q 0
  1.  W !!?5,$S(X="C":"Cancellation",1:"Deletion")," cannot be done, because your file #75.2,"
  1.  W !?5,"RAD/NUC MED REASON, does not have ""EXAM ",$S(X="C":"CANCELLED",1:"DELETED"),"""","."
  1.  W !!?5,"Please notify your ADPAC.",!
  1.  K DIR S DIR(0)="E",DIR("A")="Press RETURN for menu options" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1.  Q 1
  1.  ;
  1. DEL ; 'Exam Deletion' option (RA DELETEXAM)
  1.  D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
  1.  S RAXIT=$$CKREASON^RAEDCN1("D") I RAXIT K RAXIT Q  ;P18
  1. DEL1 D ^RACNLU G Q^RAEDCN:X="^"
  1.  I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore deletion is not allowed!" G DEL1
  1. ASKDEL R !!,"Do you wish to delete this exam? NO// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G DEL1:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" $C(7) W !!,"Enter 'YES' to delete this exam, or 'NO' not to." G ASKDEL
  1.  L +^RADPT(RADFN,"DT",RADTI):1 I '$T W !,$C(7),"Someone else is editing an exam for this patient on the date/time",!,"you selected. Please try Later" G DEL1
  1.  S RADELFLG="" D ^RAORDC
  1.  ; trigger RA CANCEL protocol on xam delete if xam not already cancelled
  1.  S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),X=+$P(RA7003,"^",3)
  1.  ; no rpt filed, xam status exists & not cancelled -OR- xam status
  1.  ; non-existent.
  1.  I $P($G(^RA(72,X,0)),U,3)'=0 D
  1.  . K RAIENS,RAERR S RAIENS=""_RACNI_","_RADTI_","_RADFN_","_"",RAFDA(70.03,RAIENS,3)="CANCELLED" D FILE^DIE("KSE","RAFDA","RAERR") K RAIENS,RAERR,RAFDA D CANCEL^RAHLRPC
  1.  . Q
  1.  ;IHS/BJI/DAY - Patch 1003 - Add hang to let HL7 messages get created
  1.  W !,"Beginning deletion - please wait " H 24
  1.  ;End Patch
  1.  K RA7003 S RABULL="",DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
  1.  ;S DIK="^RADPT(DA(2),""DT"",DA(1),""P""," D ^DIK
  1.  S DIK="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," D ^DIK
  1.  W !?10,"...deletion of exam complete."
  1.  K %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE
  1.  ; Check if one exam or multiple exams exists below "DT" node.
  1.  ; If no exams are present, delete "DT" node.
  1.  I '+$O(^RADPT(RADFN,"DT",RADTI,"P",0)) D
  1.  . K DA,DIK S DA(1)=RADFN,DA=RADTI
  1.  . ; S DIK="^RADPT(DA(1),""DT""," D ^DIK
  1.  . S DIK="^RADPT("_DA(1)_",""DT""," D ^DIK
  1.  . K DA,DIK Q
  1.  L -^RADPT(RADFN,"DT",RADTI)
  1.  G DEL1
  1.  ;
  1. VIEW ; 'View Exam by Case No.' option (RA VIEWCN)
  1.  D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
  1.  S RAVW="" D ^RACNLU G Q^RAEDCN:X="^" K RAFL D ^RAPROD D Q^RAEDCN G VIEW
  1.  ;