source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAEDCN1.m@ 1581

Last change on this file since 1581 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1RAEDCN1 ;HISC/GJC-Utility routine for RAEDCN ;9/18/97 13:49
2 ;;5.0;Radiology/Nuclear Medicine;**18,45**;Mar 16, 1998
3 ; last modif by SS for P18
4UNDEF ; Message for undefined imaging types
5 I '+$G(RAMLC) D Q
6 . W !?5,"Imaging Location data is not defined, "
7 . W "contact IRM.",$C(7)
8 . Q
9 W !?5,"An Imaging Type was not defined for the following Imaging"
10 W !?5,"Location: "_$P(^SC($P($G(^RA(79.1,+RAMLC,0)),U),0),U)_"."
11 Q
12STUB(RARPT) ; Determine if this is an imaging stub report.
13 ; Input: RARPT-ien of the report record
14 ; Output: 1 if an imaging stub rpt, else 0
15 N RA0 S RA0=$O(^RARPT(RARPT,"L",""),-1) ; most recent activity on rpt
16 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
17 Q 0 ; (non-stub rpt record)
18 ;
19PSET(RADFN,RADTI,RACNI) ; Determine if this exam is part of a printset.
20 ; Input: RADFN-patient dfn <-> RADTI-exam timestamp <-> RACNI-exam ien
21 ; Output: 1 if part of a printset, else 0
22 Q $S($P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2:1,1:0)
23 ;
24CKREASON(X) ;check file 75.2 ; P18 moved it from RAEDCN because the routine's length exceeded limit
25 ; 0=OKAY, 1=BAD
26 ; don't check for var RAOREA, because it's not set this early
27 I X="C",$O(^RA(75.2,"B","EXAM CANCELLED",0)) Q 0
28 I X="D",$O(^RA(75.2,"B","EXAM DELETED",0)) Q 0
29 W !!?5,$S(X="C":"Cancellation",1:"Deletion")," cannot be done, because your file #75.2,"
30 W !?5,"RAD/NUC MED REASON, does not have ""EXAM ",$S(X="C":"CANCELLED",1:"DELETED"),"""","."
31 W !!?5,"Please notify your ADPAC.",!
32 K DIR S DIR(0)="E",DIR("A")="Press RETURN for menu options" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT
33 Q 1
34 ;
35DEL ; 'Exam Deletion' option (RA DELETEXAM)
36 D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
37 S RAXIT=$$CKREASON^RAEDCN1("D") I RAXIT K RAXIT Q ;P18
38DEL1 D ^RACNLU G Q^RAEDCN:X="^"
39 I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore deletion is not allowed!" G DEL1
40ASKDEL 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
41 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
42 S RADELFLG="" D ^RAORDC
43 ; trigger RA CANCEL protocol on xam delete if xam not already cancelled
44 S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),X=+$P(RA7003,"^",3)
45 ; no rpt filed, xam status exists & not cancelled -OR- xam status
46 ; non-existent.
47 I $P($G(^RA(72,X,0)),U,3)'=0 D
48 . 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
49 . Q
50 K RA7003 S RABULL="",DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
51 S DIK="^RADPT(DA(2),""DT"",DA(1),""P""," D ^DIK
52 W !?10,"...deletion of exam complete."
53 K %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE
54 ; Check if one exam or multiple exams exists below "DT" node.
55 ; If no exams are present, delete "DT" node.
56 I '+$O(^RADPT(RADFN,"DT",RADTI,"P",0)) D
57 . K DA,DIK S DA(1)=RADFN,DA=RADTI
58 . S DIK="^RADPT(DA(1),""DT""," D ^DIK
59 . K DA,DIK Q
60 L -^RADPT(RADFN,"DT",RADTI)
61 G DEL1
62 ;
63VIEW ; 'View Exam by Case No.' option (RA VIEWCN)
64 D SETVARS^RAEDCN Q:'($D(RACCESS(DUZ))\10)!('$D(RAIMGTY))
65 S RAVW="" D ^RACNLU G Q^RAEDCN:X="^" K RAFL D ^RAPROD D Q^RAEDCN G VIEW
66 ;
Note: See TracBrowser for help on using the repository browser.