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 ; Feb 18, 2020@15:18:21
  1. ;;5.0;Radiology/Nuclear Medicine;**18,45,93,106,113,124,166**;Mar 16, 1998;Build 2
  1. ; last modif by SS for P18
  1. ; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
  1. ;
  1. ;Routine IA Type
  1. ;-------------------------------------
  1. ;APPERROR^%ZTER 1621 (S)
  1. ;
  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. ;
  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 report, else 0
  1. ;
  1. ;new business rules with the advent of RA*5.0*106. An
  1. ;'images collected' (Activity Log, TYPE OF ACTION field)
  1. ;event no longer defines a stub report. A stub report is
  1. ;defined as a report with the following traits:
  1. ;-------------------------------------------------------
  1. ;* Has attached images
  1. ;* Does not have a REPORT STATUS value
  1. ;* Does not have impression text
  1. ;* Does not have a problem statement
  1. ;* Does not have report text
  1. ;
  1. ;sanity check
  1. Q:RARPT'>0 0 Q:'($D(^RARPT(RARPT,0))#2) 0
  1. ;
  1. I $P(^RARPT(RARPT,0),U,5)="",$O(^RARPT(RARPT,2005,0)),'$D(^RARPT(RARPT,"I")),'$D(^("P")),'$D(^("R")) Q 1
  1. Q 0
  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 EXIT^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. ;
  1. ;RA5P166
  1. ;RAUSUNXF is set in YNCAN^RAORDC
  1. ;QUIT if timeout/^ out (-1)
  1. I $G(RAUSUNXF)=-1 K RAUSUNXF Q
  1. ;RA5P166
  1. ;
  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. K RA7003 S RABULL="",DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
  1. S RAYY=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1)
  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. ; --- delete the associated Rad dosage record RA5p113 ---
  1. D:RAYY>0 DEL^RADUTL(RAYY)
  1. ; --- end RA5P113
  1. K %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE,RAYY
  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 EXIT^RAEDCN:X="^" K RAFL D ^RAPROD D EXIT^RAEDCN G VIEW
  1. ;
  1. ;
  1. CANCEL ;cancel exam status
  1. N DA,DIERR,RA124EXST,RAERR,RAERROR,RAFDA,RAIENS,RAR
  1. ;get correct imaging type/cancelled
  1. ;is RAIMGTY defined? if so use it, else set it
  1. ;Note: RAY2 & RAY3 are defined in RAEDCN.
  1. ;
  1. I '$D(RAIMGTY)#2 D
  1. .S RAIMGTY=$P($G(^RA(79.2,+$P(RAY2,U,2),0)),U) ;xternal
  1. .Q
  1. I RAIMGTY="" D Q
  1. .D ERROR("RA: IMAGING TYPE DEFINITION ERROR")
  1. .W !!,"WARNING: CANCEL AN EXAM option aborted: Imaging Type definition error.",!!
  1. .Q
  1. S RA124EXST=$O(^RA(72,"AA",RAIMGTY,0,0)) ;IEN file 72
  1. ; for cancelled (order # = 0 4th subscript)
  1. I RA124EXST="" D Q
  1. .D ERROR("RA: INVALID EXAM STATUS")
  1. .W !!,"WARNING: CANCEL AN EXAM option aborted: Exam Status definition error.",!!
  1. .Q
  1. ;
  1. ;update 70.03, field 3 EXAM STATUS
  1. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
  1. S RAIENS=$$IENS^DILF(.DA) K DA
  1. ;
  1. S RAFDA(70.03,RAIENS,3)=RA124EXST
  1. ;update 70.03, field 3.5 REASON FOR CANCELLATION
  1. S:$G(RAREASON)'="" RAFDA(70.03,RAIENS,3.5)=RAREASON
  1. D FILE^DIE(,"RAFDA","RAERROR")
  1. I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING SUB-DD;FIELD: 70.03;3 or 70.03;3.5" D ERROR(RADESC)
  1. ;
  1. ;do I care about editing 70.03 ; 3.5? REASON FOR CANCELLATION
  1. ;
  1. ALOG ;update activity (70.03 ; 100) log
  1. K DIERR,RAERROR,RAFDA
  1. S RAR=$NA(RAFDA(70.07,"+1,"_RAIENS))
  1. ;.01 - log date
  1. S @RAR@(.01)=$E($$NOW^XLFDT(),1,12) ;internal
  1. ;field #: 2 - type of action
  1. S @RAR@(2)="X" ; 'X' = cancelled internal
  1. ;field #: 3 - computer user
  1. S @RAR@(3)=DUZ ;internal
  1. ;field #4: technologist comment "TCOM" node
  1. ;internal
  1. S:$G(RATCOM)'="" @RAR@(4)=RATCOM ;internal
  1. D UPDATE^DIE("","RAFDA","RAIENS","RAERROR") ;file as internal what if error?
  1. I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING 'ACTIVITY LOG' (70.03 ; 100) MULTIPLE" D ERROR(RADESC)
  1. ;
  1. XSTIME ;update exam status times (70.03 ; 75) log
  1. K RAIENS(1),DIERR,RAERROR,RAFDA
  1. S RAR=$NA(RAFDA(70.05,"+1,"_RAIENS))
  1. ;.01 - status change date/time
  1. S @RAR@(.01)=$E($$NOW^XLFDT(),1,12) ;internal
  1. ;field #: 2 - new status
  1. S @RAR@(2)=RA124EXST ;internal
  1. ;field #: 3 - computer user
  1. S @RAR@(3)=DUZ ;internal
  1. D UPDATE^DIE("","RAFDA","RAIENS","RAERROR")
  1. I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING 'EXAM STATUS TIMES' (70.03 ; 75) MULTIPLE" D ERROR(RADESC)
  1. ;
  1. W !!?3,"... exam cancellation complete."
  1. Q
  1. ;
  1. ERROR(RADESC) ;trip error trap hit primarily for CANCEL AN EXAM
  1. D APPERROR^%ZTER(RADESC)
  1. Q
  1. ;