source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAEDCN1.m

RAEDCN1 ;HISC/GJC-Utility routine for RAEDCN ;9/18/97  13:49
 ;;5.0;Radiology/Nuclear Medicine;**18,45**;Mar 16, 1998
 ; last modif by SS for P18
UNDEF ; Message for undefined imaging types
 I '+$G(RAMLC) D  Q
 . W !?5,"Imaging Location data is not defined, "
 . W "contact IRM.",$C(7)
 . Q
 W !?5,"An Imaging Type was not defined for the following Imaging"
 W !?5,"Location: "_$P(^SC($P($G(^RA(79.1,+RAMLC,0)),U),0),U)_"."
 Q
STUB(RARPT) ; Determine if this is an imaging stub report.
 ; Input: RARPT-ien of the report record
 ; Output: 1 if an imaging stub rpt, else 0
 N RA0 S RA0=$O(^RARPT(RARPT,"L",""),-1) ; most recent activity on rpt
 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
 Q 0 ; (non-stub rpt record)
 ;
PSET(RADFN,RADTI,RACNI) ; Determine if this exam is part of a printset.
 ; Input: RADFN-patient dfn <-> RADTI-exam timestamp <-> RACNI-exam ien
 ; Output: 1 if part of a printset, else 0
 Q $S($P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2:1,1:0)
 ;
CKREASON(X) ;check file 75.2 ; P18 moved it from RAEDCN because the routine's length exceeded limit
 ; 0=OKAY, 1=BAD
 ; don't check for var RAOREA, because it's not set this early
 I X="C",$O(^RA(75.2,"B","EXAM CANCELLED",0)) Q 0
 I X="D",$O(^RA(75.2,"B","EXAM DELETED",0)) Q 0
 W !!?5,$S(X="C":"Cancellation",1:"Deletion")," cannot be done, because your file #75.2,"
 W !?5,"RAD/NUC MED REASON, does not have ""EXAM ",$S(X="C":"CANCELLED",1:"DELETED"),"""","."
 W !!?5,"Please notify your ADPAC.",!
 K DIR S DIR(0)="E",DIR("A")="Press RETURN for menu options" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT
 Q 1
 ;
DEL ; 'Exam Deletion' option (RA DELETEXAM)
 D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
 S RAXIT=$$CKREASON^RAEDCN1("D") I RAXIT K RAXIT Q  ;P18
DEL1 D ^RACNLU G Q^RAEDCN:X="^"
 I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore deletion is not allowed!" G DEL1
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
 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
 S RADELFLG="" D ^RAORDC
 ; trigger RA CANCEL protocol on xam delete if xam not already cancelled
 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),X=+$P(RA7003,"^",3)
 ; no rpt filed, xam status exists & not cancelled -OR- xam status
 ; non-existent.
 I $P($G(^RA(72,X,0)),U,3)'=0 D
 . 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
 . Q
 K RA7003 S RABULL="",DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
 S DIK="^RADPT(DA(2),""DT"",DA(1),""P""," D ^DIK
 W !?10,"...deletion of exam complete."
 K %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE
 ; Check if one exam or multiple exams exists below "DT" node.
 ; If no exams are present, delete "DT" node.
 I '+$O(^RADPT(RADFN,"DT",RADTI,"P",0)) D
 . K DA,DIK S DA(1)=RADFN,DA=RADTI
 . S DIK="^RADPT(DA(1),""DT""," D ^DIK
 . K DA,DIK Q
 L -^RADPT(RADFN,"DT",RADTI)
 G DEL1
 ;
VIEW ; 'View Exam by Case No.' option (RA VIEWCN)
 D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
 S RAVW="" D ^RACNLU G Q^RAEDCN:X="^" K RAFL D ^RAPROD D Q^RAEDCN G VIEW
 ;