RAEDCN1 ;HISC/GJC-Utility routine for RAEDCN ; Feb 18, 2020@15:18:21
;;5.0;Radiology/Nuclear Medicine;**18,45,93,106,113,124,166**;Mar 16, 1998;Build 2
; last modif by SS for P18
; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
;
;Routine IA Type
;-------------------------------------
;APPERROR^%ZTER 1621 (S)
;
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 report, else 0
;
;new business rules with the advent of RA*5.0*106. An
;'images collected' (Activity Log, TYPE OF ACTION field)
;event no longer defines a stub report. A stub report is
;defined as a report with the following traits:
;-------------------------------------------------------
;* Has attached images
;* Does not have a REPORT STATUS value
;* Does not have impression text
;* Does not have a problem statement
;* Does not have report text
;
;sanity check
Q:RARPT'>0 0 Q:'($D(^RARPT(RARPT,0))#2) 0
;
I $P(^RARPT(RARPT,0),U,5)="",$O(^RARPT(RARPT,2005,0)),'$D(^RARPT(RARPT,"I")),'$D(^("P")),'$D(^("R")) Q 1
Q 0
;
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 EXIT^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
;
;RA5P166
;RAUSUNXF is set in YNCAN^RAORDC
;QUIT if timeout/^ out (-1)
I $G(RAUSUNXF)=-1 K RAUSUNXF Q
;RA5P166
;
; 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 RAYY=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1)
;S DIK="^RADPT(DA(2),""DT"",DA(1),""P""," D ^DIK
S DIK="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P""," D ^DIK
W !?10,"...deletion of exam complete."
; --- delete the associated Rad dosage record RA5p113 ---
D:RAYY>0 DEL^RADUTL(RAYY)
; --- end RA5P113
K %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE,RAYY
; 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
. 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 EXIT^RAEDCN:X="^" K RAFL D ^RAPROD D EXIT^RAEDCN G VIEW
;
;
CANCEL ;cancel exam status
N DA,DIERR,RA124EXST,RAERR,RAERROR,RAFDA,RAIENS,RAR
;get correct imaging type/cancelled
;is RAIMGTY defined? if so use it, else set it
;Note: RAY2 & RAY3 are defined in RAEDCN.
;
I '$D(RAIMGTY)#2 D
.S RAIMGTY=$P($G(^RA(79.2,+$P(RAY2,U,2),0)),U) ;xternal
.Q
I RAIMGTY="" D Q
.D ERROR("RA: IMAGING TYPE DEFINITION ERROR")
.W !!,"WARNING: CANCEL AN EXAM option aborted: Imaging Type definition error.",!!
.Q
S RA124EXST=$O(^RA(72,"AA",RAIMGTY,0,0)) ;IEN file 72
; for cancelled (order # = 0 4th subscript)
I RA124EXST="" D Q
.D ERROR("RA: INVALID EXAM STATUS")
.W !!,"WARNING: CANCEL AN EXAM option aborted: Exam Status definition error.",!!
.Q
;
;update 70.03, field 3 EXAM STATUS
S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
S RAIENS=$$IENS^DILF(.DA) K DA
;
S RAFDA(70.03,RAIENS,3)=RA124EXST
;update 70.03, field 3.5 REASON FOR CANCELLATION
S:$G(RAREASON)'="" RAFDA(70.03,RAIENS,3.5)=RAREASON
D FILE^DIE(,"RAFDA","RAERROR")
I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING SUB-DD;FIELD: 70.03;3 or 70.03;3.5" D ERROR(RADESC)
;
;do I care about editing 70.03 ; 3.5? REASON FOR CANCELLATION
;
ALOG ;update activity (70.03 ; 100) log
K DIERR,RAERROR,RAFDA
S RAR=$NA(RAFDA(70.07,"+1,"_RAIENS))
;.01 - log date
S @RAR@(.01)=$E($$NOW^XLFDT(),1,12) ;internal
;field #: 2 - type of action
S @RAR@(2)="X" ; 'X' = cancelled internal
;field #: 3 - computer user
S @RAR@(3)=DUZ ;internal
;field #4: technologist comment "TCOM" node
;internal
S:$G(RATCOM)'="" @RAR@(4)=RATCOM ;internal
D UPDATE^DIE("","RAFDA","RAIENS","RAERROR") ;file as internal what if error?
I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING 'ACTIVITY LOG' (70.03 ; 100) MULTIPLE" D ERROR(RADESC)
;
XSTIME ;update exam status times (70.03 ; 75) log
K RAIENS(1),DIERR,RAERROR,RAFDA
S RAR=$NA(RAFDA(70.05,"+1,"_RAIENS))
;.01 - status change date/time
S @RAR@(.01)=$E($$NOW^XLFDT(),1,12) ;internal
;field #: 2 - new status
S @RAR@(2)=RA124EXST ;internal
;field #: 3 - computer user
S @RAR@(3)=DUZ ;internal
D UPDATE^DIE("","RAFDA","RAIENS","RAERROR")
I $D(DIERR)#2 S RADESC="RA: ERROR UPDATING 'EXAM STATUS TIMES' (70.03 ; 75) MULTIPLE" D ERROR(RADESC)
;
W !!?3,"... exam cancellation complete."
Q
;
ERROR(RADESC) ;trip error trap hit primarily for CANCEL AN EXAM
D APPERROR^%ZTER(RADESC)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAEDCN1 6963 printed Apr 09, 2024@21:39:40 Page 2
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
+2 ; last modif by SS for P18
+3 ; 07/15/2008 BAY/KAM rem call 249750 RA*5*93 Correct DIK Calls
+4 ;
+5 ;Routine IA Type
+6 ;-------------------------------------
+7 ;APPERROR^%ZTER 1621 (S)
+8 ;
UNDEF ; Message for undefined imaging types
+1 IF '+$GET(RAMLC)
Begin DoDot:1
+2 WRITE !?5,"Imaging Location data is not defined, "
+3 WRITE "contact IRM.",$CHAR(7)
+4 QUIT
End DoDot:1
QUIT
+5 WRITE !?5,"An Imaging Type was not defined for the following Imaging"
+6 WRITE !?5,"Location: "_$PIECE(^SC($PIECE($GET(^RA(79.1,+RAMLC,0)),U),0),U)_"."
+7 QUIT
+8 ;
STUB(RARPT) ; Determine if this is an imaging stub report.
+1 ; Input : RARPT: IEN of the report record
+2 ; Output: 1 if an imaging stub report, else 0
+3 ;
+4 ;new business rules with the advent of RA*5.0*106. An
+5 ;'images collected' (Activity Log, TYPE OF ACTION field)
+6 ;event no longer defines a stub report. A stub report is
+7 ;defined as a report with the following traits:
+8 ;-------------------------------------------------------
+9 ;* Has attached images
+10 ;* Does not have a REPORT STATUS value
+11 ;* Does not have impression text
+12 ;* Does not have a problem statement
+13 ;* Does not have report text
+14 ;
+15 ;sanity check
+16 if RARPT'>0
QUIT 0
if '($DATA(^RARPT(RARPT,0))#2)
QUIT 0
+17 ;
+18 IF $PIECE(^RARPT(RARPT,0),U,5)=""
IF $ORDER(^RARPT(RARPT,2005,0))
IF '$DATA(^RARPT(RARPT,"I"))
IF '$DATA(^("P"))
IF '$DATA(^("R"))
QUIT 1
+19 QUIT 0
+20 ;
PSET(RADFN,RADTI,RACNI) ; Determine if this exam is part of a printset.
+1 ; Input: RADFN-patient dfn <-> RADTI-exam timestamp <-> RACNI-exam ien
+2 ; Output: 1 if part of a printset, else 0
+3 QUIT $SELECT($PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2:1,1:0)
+4 ;
CKREASON(X) ;check file 75.2 ; P18 moved it from RAEDCN because the routine's length exceeded limit
+1 ; 0=OKAY, 1=BAD
+2 ; don't check for var RAOREA, because it's not set this early
+3 IF X="C"
IF $ORDER(^RA(75.2,"B","EXAM CANCELLED",0))
QUIT 0
+4 IF X="D"
IF $ORDER(^RA(75.2,"B","EXAM DELETED",0))
QUIT 0
+5 WRITE !!?5,$SELECT(X="C":"Cancellation",1:"Deletion")," cannot be done, because your file #75.2,"
+6 WRITE !?5,"RAD/NUC MED REASON, does not have ""EXAM ",$SELECT(X="C":"CANCELLED",1:"DELETED"),"""","."
+7 WRITE !!?5,"Please notify your ADPAC.",!
+8 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press RETURN for menu options"
DO ^DIR
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+9 QUIT 1
+10 ;
DEL ; 'Exam Deletion' option (RA DELETEXAM)
+1 DO SETVARS^RAEDCN
if '($DATA(RACCESS(DUZ))\10)!('$DATA(RAIMGTY))
QUIT
+2 ;P18
SET RAXIT=$$CKREASON^RAEDCN1("D")
IF RAXIT
KILL RAXIT
QUIT
DEL1 DO ^RACNLU
if X="^"
GOTO EXIT^RAEDCN
+1 IF RARPT
WRITE !?3,$CHAR(7),"A report has been filed for this case. Therefore deletion is not allowed!"
GOTO DEL1
ASKDEL READ !!,"Do you wish to delete this exam? NO// ",X:DTIME
if '$TEST!(X="")!(X["^")
SET X="N"
if "Nn"[$EXTRACT(X)
GOTO DEL1
IF "Yy"'[$EXTRACT(X)
if X'["?"
WRITE $CHAR(7)
WRITE !!,"Enter 'YES' to delete this exam, or 'NO' not to."
GOTO ASKDEL
+1 LOCK +^RADPT(RADFN,"DT",RADTI):1
IF '$TEST
WRITE !,$CHAR(7),"Someone else is editing an exam for this patient on the date/time",!,"you selected. Please try Later"
GOTO DEL1
+2 SET RADELFLG=""
DO ^RAORDC
+3 ;
+4 ;RA5P166
+5 ;RAUSUNXF is set in YNCAN^RAORDC
+6 ;QUIT if timeout/^ out (-1)
+7 IF $GET(RAUSUNXF)=-1
KILL RAUSUNXF
QUIT
+8 ;RA5P166
+9 ;
+10 ; trigger RA CANCEL protocol on xam delete if xam not already cancelled
+11 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
SET X=+$PIECE(RA7003,"^",3)
+12 ; no rpt filed, xam status exists & not cancelled -OR- xam status
+13 ; non-existent.
+14 IF $PIECE($GET(^RA(72,X,0)),U,3)'=0
Begin DoDot:1
+15 KILL RAIENS,RAERR
SET RAIENS=""_RACNI_","_RADTI_","_RADFN_","_""
SET RAFDA(70.03,RAIENS,3)="CANCELLED"
DO FILE^DIE("KSE","RAFDA","RAERR")
KILL RAIENS,RAERR,RAFDA
DO CANCEL^RAHLRPC
+16 QUIT
End DoDot:1
+17 KILL RA7003
SET RABULL=""
SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
+18 SET RAYY=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1)
+19 ;S DIK="^RADPT(DA(2),""DT"",DA(1),""P""," D ^DIK
+20 SET DIK="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
DO ^DIK
+21 WRITE !?10,"...deletion of exam complete."
+22 ; --- delete the associated Rad dosage record RA5p113 ---
+23 if RAYY>0
DO DEL^RADUTL(RAYY)
+24 ; --- end RA5P113
+25 KILL %,D,D0,D1,D2,DA,DIC,DIK,RADELFLG,RABULL,RAPRTZ,RAAFTER,RABEFORE,RAYY
+26 ; Check if one exam or multiple exams exists below "DT" node.
+27 ; If no exams are present, delete "DT" node.
+28 IF '+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",0))
Begin DoDot:1
+29 KILL DA,DIK
SET DA(1)=RADFN
SET DA=RADTI
+30 ; S DIK="^RADPT(DA(1),""DT""," D ^DIK
+31 SET DIK="^RADPT("_DA(1)_",""DT"","
DO ^DIK
+32 KILL DA,DIK
QUIT
End DoDot:1
+33 LOCK -^RADPT(RADFN,"DT",RADTI)
+34 GOTO DEL1
+35 ;
VIEW ; 'View Exam by Case No.' option (RA VIEWCN)
+1 DO SETVARS^RAEDCN
if '($DATA(RACCESS(DUZ))\10)!('$DATA(RAIMGTY))
QUIT
+2 SET RAVW=""
DO ^RACNLU
if X="^"
GOTO EXIT^RAEDCN
KILL RAFL
DO ^RAPROD
DO EXIT^RAEDCN
GOTO VIEW
+3 ;
+4 ;
CANCEL ;cancel exam status
+1 NEW DA,DIERR,RA124EXST,RAERR,RAERROR,RAFDA,RAIENS,RAR
+2 ;get correct imaging type/cancelled
+3 ;is RAIMGTY defined? if so use it, else set it
+4 ;Note: RAY2 & RAY3 are defined in RAEDCN.
+5 ;
+6 IF '$DATA(RAIMGTY)#2
Begin DoDot:1
+7 ;xternal
SET RAIMGTY=$PIECE($GET(^RA(79.2,+$PIECE(RAY2,U,2),0)),U)
+8 QUIT
End DoDot:1
+9 IF RAIMGTY=""
Begin DoDot:1
+10 DO ERROR("RA: IMAGING TYPE DEFINITION ERROR")
+11 WRITE !!,"WARNING: CANCEL AN EXAM option aborted: Imaging Type definition error.",!!
+12 QUIT
End DoDot:1
QUIT
+13 ;IEN file 72
SET RA124EXST=$ORDER(^RA(72,"AA",RAIMGTY,0,0))
+14 ; for cancelled (order # = 0 4th subscript)
+15 IF RA124EXST=""
Begin DoDot:1
+16 DO ERROR("RA: INVALID EXAM STATUS")
+17 WRITE !!,"WARNING: CANCEL AN EXAM option aborted: Exam Status definition error.",!!
+18 QUIT
End DoDot:1
QUIT
+19 ;
+20 ;update 70.03, field 3 EXAM STATUS
+21 SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
+22 SET RAIENS=$$IENS^DILF(.DA)
KILL DA
+23 ;
+24 SET RAFDA(70.03,RAIENS,3)=RA124EXST
+25 ;update 70.03, field 3.5 REASON FOR CANCELLATION
+26 if $GET(RAREASON)'=""
SET RAFDA(70.03,RAIENS,3.5)=RAREASON
+27 DO FILE^DIE(,"RAFDA","RAERROR")
+28 IF $DATA(DIERR)#2
SET RADESC="RA: ERROR UPDATING SUB-DD;FIELD: 70.03;3 or 70.03;3.5"
DO ERROR(RADESC)
+29 ;
+30 ;do I care about editing 70.03 ; 3.5? REASON FOR CANCELLATION
+31 ;
ALOG ;update activity (70.03 ; 100) log
+1 KILL DIERR,RAERROR,RAFDA
+2 SET RAR=$NAME(RAFDA(70.07,"+1,"_RAIENS))
+3 ;.01 - log date
+4 ;internal
SET @RAR@(.01)=$EXTRACT($$NOW^XLFDT(),1,12)
+5 ;field #: 2 - type of action
+6 ; 'X' = cancelled internal
SET @RAR@(2)="X"
+7 ;field #: 3 - computer user
+8 ;internal
SET @RAR@(3)=DUZ
+9 ;field #4: technologist comment "TCOM" node
+10 ;internal
+11 ;internal
if $GET(RATCOM)'=""
SET @RAR@(4)=RATCOM
+12 ;file as internal what if error?
DO UPDATE^DIE("","RAFDA","RAIENS","RAERROR")
+13 IF $DATA(DIERR)#2
SET RADESC="RA: ERROR UPDATING 'ACTIVITY LOG' (70.03 ; 100) MULTIPLE"
DO ERROR(RADESC)
+14 ;
XSTIME ;update exam status times (70.03 ; 75) log
+1 KILL RAIENS(1),DIERR,RAERROR,RAFDA
+2 SET RAR=$NAME(RAFDA(70.05,"+1,"_RAIENS))
+3 ;.01 - status change date/time
+4 ;internal
SET @RAR@(.01)=$EXTRACT($$NOW^XLFDT(),1,12)
+5 ;field #: 2 - new status
+6 ;internal
SET @RAR@(2)=RA124EXST
+7 ;field #: 3 - computer user
+8 ;internal
SET @RAR@(3)=DUZ
+9 DO UPDATE^DIE("","RAFDA","RAIENS","RAERROR")
+10 IF $DATA(DIERR)#2
SET RADESC="RA: ERROR UPDATING 'EXAM STATUS TIMES' (70.03 ; 75) MULTIPLE"
DO ERROR(RADESC)
+11 ;
+12 WRITE !!?3,"... exam cancellation complete."
+13 QUIT
+14 ;
ERROR(RADESC) ;trip error trap hit primarily for CANCEL AN EXAM
+1 DO APPERROR^%ZTER(RADESC)
+2 QUIT
+3 ;
