- 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 Jan 18, 2025@03:35:57 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 ;