Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAEDCN

RAEDCN.m

Go to the documentation of this file.
  1. RAEDCN ;HISC/CAH,FPT,GJC,SS AISC/MJK,RMO-Edit Exams by Case Number ; Feb 19, 2021@08:08:21
  1. ;;5.0;Radiology/Nuclear Medicine;**5,13,10,18,28,31,34,45,85,97,124,175**;Mar 16, 1998;Build 2
  1. ;
  1. ; 06/11/2007 KAM/BAY RA*5*85 Remedy Call 174790 Change Exam Cancel
  1. ; to allow only descendent exams with stub report
  1. ;
  1. ;last modified by SS JUNE 21,2000 for P18
  1. START D SET^RAPSET1 I $D(XQUIT) K XQUIT,RAFLG,RADR,POP,RAQUICK Q
  1. START1 ;
  1. N RAERR
  1. D ^RACNLU S RAERR=0 G EXIT:X="^"
  1. I RADR="[RA DIAGNOSTIC BY CASE]" D I RAERR R !?5,"Press RETURN to exit:",RAXIT:DTIME G EXIT
  1. .N RAPRTSET,RAMEMARR,RA3,RA7003,RA17
  1. .D EN2^RAUTL20(.RAMEMARR)
  1. .S RA3=99
  1. .; disallow case that is a member of a printset, fld 25 = 2
  1. .I RAPRTSET W ! D WHYMSG2^RASTED S RAERR=1 Q
  1. .S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .S RA17=$P(RA7003,U,17)
  1. .; disallow case that has no report or has stub report
  1. .I 'RA17!($$STUB^RAEDCN1(+RA17)) S RAERR=1 W !?3,$C(7),"No report has been entered yet for this exam, therefore it cannot be edited.",! Q
  1. .; disallow case that has an elec. filed report
  1. .I $P($G(^RARPT(+RA17,0)),U,5)="EF" S RAERR=1 D WARN1 Q
  1. .Q
  1. I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",+$G(DUZ))) W !!?3,$C(7),"You do not have the appropriate access privileges to edit completed exams." G START1
  1. I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore it cannot be edited." G START1
  1. I RADR="[RA DIAGNOSTIC BY CASE]",$D(^RARPT(RARPT,0)),$P(^(0),"^",5)="V" W !!?3,$C(7),"A report has been verified for this exam, therefore it cannot be edited.",! G START
  1. S DA=RADFN,DIE("NO^")="OUTOK",DIE="^RADPT(",DR=RADR
  1. I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D G:+$G(RAXIT) START1
  1. . S RADADA=RADTI,RADIE="^RADPT("_RADFN_",""DT"","
  1. . S RAXIT=$$LOCK^RAUTL12(RADIE,RADADA)
  1. . Q
  1. I RADR="[RA EXAM EDIT]" D
  1. . N RADISPLY
  1. . S RADISPLY=$G(^RAMIS(71,+$P($G(^RADPT(+RADFN,"DT",+RADTI,"P",+RACNI,0)),U,2),0)) ; set $ZR to 71 for prccpt^radd1, not call raprod since diff col
  1. . S RADISPLY=$$PRCCPT^RADD1()
  1. . W !,?24,RADISPLY
  1. .;
  1. .;save 'before' CM data value to compare against the possible 'after'
  1. .;value
  1. .D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB) ;RA*5*45
  1. .;
  1. . Q
  1. D:RADR'="[RA NO PURGE SPECIFICATION]" SVBEFOR^RAO7XX(RADFN,RADTI,RACNI) ;P18 save before edit to compare it in RAUTL1 later
  1. D ^DIE K DIE("NO^"),DE,DQ,DIE,DR,RAZCM
  1. D:RADR'="[RA NO PURGE SPECIFICATION]" UP1^RAUTL1
  1. ;
  1. ;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST
  1. ;MEDIA'
  1. ;2) check 'before' CM data against 'after' CM data, file in audit log
  1. ;if necessary. Remember, contrast media asked when in input template:
  1. ;RA EXAM EDIT (RA*5*45)
  1. I RADR="[RA EXAM EDIT]" D
  1. .S RACMDA=RACNI,RACMDA(1)=RADTI,RACMDA(2)=RADFN
  1. .D XCMINTEG^RAMAINU1(.RACMDA) ;1
  1. .D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB) ;2
  1. .K RACMDA Q
  1. ;
  1. I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D UNLOCK^RAUTL12(RADIE,RADADA)
  1. K RATRKCMB,RADUZ,RAZZ W ! G START1:'+$G(RAXIT)
  1. ;
  1. EXIT ;clean up symbol table and exit
  1. K %,%DT,%W,%X,%Y,%Y1,A,C,D0,D1,D2,DA,DIC,DIE,DIV,DK,I,ORIFN,ORVP,POP,RACN,RACNI,RACS,RACT,RADADA,RADATE,RADFN,RADIE,RADIV,RADR,RADTE,RADTI,RAEXFM,RAEXLBLS,RAFIN,RAFL,RAFLG,RAFLH,RAFLHFL,RAHEAD,RAI,RAJ
  1. K RAMES,RANME,RANUM,RAOIFN,RAOR,RAORDIFN,RAOREA,RAORIFN,RAOSEL,RAOSTS,RAPOP,RAPRI,RAPRC,RAQUICK,RAPRIT,RARPT,RARPTZ,RASN,RASSN,RAST,RASTI,RAVW,X,XQUIT,VAINDT,VADMVT,Y,^TMP($J,"RAEX")
  1. K %H,%I,D,D3,DDER,DI,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,GMRAL,RAEXOR
  1. K J,SDCLST,R1,RA,RACANC,RACN0,RACPT,RACPTNDE,RADA,RAEND,RAFELIG,RAFST
  1. K RAIX,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RAXIT,VA,VADM,VAERR,Z
  1. K DFN,DIPGM,DISYS,DQ,DR,HLN,HLRESLT,HLSAN,RAAFTER,RABEFORE,X0
  1. K DLAYGO,DDH,RADFLTP
  1. Q
  1. ;
  1. DIAG N RADIAG,RAXIT
  1. S RAXIT=0,RAFLG("DIAG")="",RADR="[RA DIAGNOSTIC BY CASE]" G START
  1. ;
  1. SAVE S RADR="[RA NO PURGE SPECIFICATION]" G START
  1. ;
  1. EDIT ; Case No. Exam Edit
  1. N RAEDIT,RAXIT
  1. N RAREM,RANUZD1,RAPSDRUG,RA00,RADIOPH,RALOW,RAHI,RADRAWN,RAASK,RADOSE,RASKMEDS,RAWHICH ;these are used by the edit template
  1. S RAXIT=0,RAFLG("EDIT")="",RAQUICK=1,RADR="[RA EXAM EDIT]" G START
  1. ;
  1. CANCEL ;new w/RA5p124
  1. D SET^RAPSET1 ;checks for DUZ if not defined we exit
  1. I $D(XQUIT) K XQUIT Q
  1. ;
  1. ;check for EXAM CANCELLED ("C") 0 if found, else 1
  1. Q:$$CKREASON^RAEDCN1("C")=1 ;RA5P124
  1. ;
  1. ;*** this code down to ASKCAN stays w/124 ***
  1. D ^RACNLU G EXIT:X="^" I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !?3,$C(7),"This exam has already been cancelled!" G EXIT
  1. I $D(^RA(72,+RAST,0)),$P(^(0),"^",6)'="y" W !?3,$C(7),"This exam is in the '",$P(^(0),"^"),"' status and cannot be 'CANCELLED'." G EXIT
  1. ; 06/11/2007 KAM/BAY *85 Added descendent check to next line
  1. ASKIMG I RARPT,($$STUB^RAEDCN1(RARPT)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)) D G:"Nn"[$E(X) EXIT G:"Yy"[$E(X) ASKCAN W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel a descendent exam with images, or 'NO' not to." G ASKIMG
  1. . S X=RANME_"'s Case No. "_$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN ;p175
  1. . W !!?10,"----------------------------------",$C(7)
  1. . W !?10,X
  1. . W !?10,"This descendent exam has associated images.",$C(7)
  1. . W !?10,"----------------------------------",$C(7)
  1. . I '$D(^XUSEC("RA MGR",DUZ)) D S X="N" Q
  1. .. W !!?3,"** You do not have the RA MGR key to cancel an exam with images. **",$C(7)
  1. .. R !!?10,"Press RETURN to continue.",X:DTIME
  1. .. Q
  1. . R !!,"Do you really want to cancel this exam with images? NO//",X:DTIME S:'$T!(X="")!(X["^") X="N"
  1. . Q
  1. ;
  1. I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore cancellation is not allowed!" G EXIT
  1. ;
  1. ;is someone editing this patient record? if yes, quit (check moved w/RA5p124)
  1. L +^RADPT(RADFN):1 I '$T W !,$C(7),"Someone else is editing the patient you selected",!,"Please try later" K RADTE,RACN,RAPOP,RADUZ G EXIT
  1. ; you set a lock, you must clear it!
  1. ;
  1. ASKCAN ;interact with the user use DIR RA5p124
  1. N %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RAY2,RAY3,X,Y
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("?")="Enter 'YES' to cancel this exam. or 'NO' not to."
  1. S DIR("A")="Do you wish to cancel this exam now"
  1. D ^DIR
  1. ;Yes/No: Y=1 for yes else Y=0 for no
  1. ;$D(DIRUT) indicates caret or timeout
  1. I $D(DIRUT)!(Y=0) D Q
  1. .L -^RADPT(RADFN) ;unlock
  1. .D EXIT ;cleanup vars
  1. .Q
  1. ;/ end askcan /
  1. ;
  1. ;When an exam is cancelled & it is associated with data in the Nuc
  1. ;Med Exam Data file (70.2) ask the user if this pointer to 70.2 is
  1. ;to be deleted. Also delete the flag 'Dosage Ticket Printed?' which
  1. ;indicates that the dosage ticket had printed for this exam.
  1. D DELPNT^RAUTL20(RADFN,RADTI,RACNI)
  1. ;
  1. ;get TECHNOLOGIST COMMENT & REASON FOR CANCELLATION (both optional)
  1. K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S RATCOM=$$GETTCOM^RAUTL11(RADFN,RADTI,RACNI) ;pseudo default
  1. S DIR(0)="70.07,4A",DIR("A")="TECHNOLOGIST COMMENT: "_RATCOM_"//" D ^DIR
  1. I $D(DUOUT)#2!($D(DTOUT)#2) L -^RADPT(RADFN) D EXIT QUIT
  1. S RATCOM=$P(Y,U)
  1. ;
  1. ;/*** RA5_0P175 begin ***/
  1. K DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="70.03,3.5^^I ""^1^9^""[(U_$P(^(0),U,2)_U)"
  1. S DIR("A")="REASON FOR CANCELLATION" D ^DIR
  1. I $D(DUOUT)#2!($D(DTOUT)#2) L -^RADPT(RADFN) D EXIT QUIT
  1. ; Staying true to past functionality, this is not a required
  1. ; field. There is no default reason presented to the user.
  1. S RAREASON=$S(+Y>0:+Y,1:$O(^RA(75.2,"B","EXAM CANCELLED","")))
  1. ; >>> RA5_0P175 'EXAM CANCELLED' becomes the default reason <<<
  1. ;/*** RA5_0P175 end ***/
  1. ;
  1. ;(we've not canceled the exam just yet)
  1. S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) ;70.02
  1. S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;70.03
  1. S RAOIFN=+$P(RAY3,U,11)
  1. ;
  1. ;In EXMCAN^RAORDC the logic (EN1^RASETU) is called to check
  1. ;if there are multiple studies registered for the same date/time.
  1. ;RAEXOR = the ORDER of the exam status for the exam in play
  1. ;RAOSTS = is the request status the order will be set to.
  1. S (RAEXOR,RAOSTS)=0 D EXMCAN^RAORDC
  1. ;
  1. ;check if the user times out or ^'s out (function returns -1)
  1. ;when asked if they want to cancel the order in RAORDC.
  1. I RAOSTS=-1 L -^RADPT(RADFN) Q
  1. ;
  1. ;cancel the exam, update exam status tracking and activity logs
  1. D CANCEL^RAEDCN1
  1. ;release the lock
  1. L -^RADPT(RADFN)
  1. ;
  1. PACS ;call all RA CANCEL* event drivers only if the order status
  1. ;and exam status have been updated! this is a new LOCK series
  1. D CANCEL^RAHLRPC
  1. D EXIT ;cleanup
  1. QUIT
  1. ;
  1. ;
  1. DUP ; Option: RA FLASH
  1. N RAREGX,RAYN D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
  1. DUP1 D ^RACNLU G EXIT:X="^"
  1. G EXIT:'$D(^RADPT(RADFN,"DT",RADTI,0))
  1. S RAREGX(0)=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. S RAREGX(4)=+$P(RAREGX(0),"^",4)
  1. I +$G(RAMLC)'=RAREGX(4) D I $P(RAYN,"^",2) D EXIT QUIT
  1. . W !!?3,"Your sign-on location is: "
  1. . W $P($G(^SC(+$G(^RA(79.1,+$G(RAMLC),0)),0)),"^")_". The location"
  1. . W !?3,"of case ",RACN," is "
  1. . W $P($G(^SC(+$G(^RA(79.1,RAREGX(4),0)),0)),"^"),".",!
  1. . K DIR,DIROUT,DIRUT,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Yes"
  1. . S DIR("?")="Enter 'Y'es to switch locations or 'N'o exit the option."
  1. . S DIR("A")="Do you wish to switch Imaging Locations" D ^DIR
  1. . S RAYN=+Y_"^"_$S($D(DIRUT):1,1:0)
  1. . K DIR,DIROUT,DIRUT,DTOUT,DUOUT Q:'+RAYN ; quit if no
  1. . D KILL^RAPSET1,SET^RAPSET1 ; else switch locations
  1. . I $D(XQUIT) S $P(RAYN,"^",2)=1 K XQUIT
  1. . Q
  1. S ION=$P(RAMLC,"^",3) ; imaging location flash card printer (if any)
  1. G EXIT:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S Y=^(0),Y=$S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^",3),1:"")
  1. ; if Y, then convert the pointer value 'Y' to the .01 value of
  1. ; the procedure flash card printer (if any)
  1. I Y]"",$D(^%ZIS(1,+Y,0)) D
  1. . S Y(0)=$$GET1^DIQ(3.5,+Y,.01) ; .01 value for proc flash card printer
  1. . S:Y(0)'=$P(RAMLC,"^",3) ION=Y(0) K Y(0)
  1. . ; if flash card printer for the imaging location differs from
  1. . ; the procedure flash card printer, default (print to) to the flash
  1. . ; card printer for the procedure.
  1. . Q
  1. S RAMES="W !!,""Duplicates queued to print on "",ION,"".""",RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1),RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1),RAFLHFL=RACNI
  1. FLH ; Flash Cards
  1. R !,"How many flash cards? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RANUM=X I '(RANUM?.N)!(RANUM>20) W !?3,$C(7),"Must be a whole number less than 21!" G FLH
  1. EXM ; Exam Labels
  1. R !,"How many exam labels? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RAEXLBLS=X I '(RAEXLBLS?.N)!(RAEXLBLS>20) W !?3,$C(7),"Must be a whole number less than 21!" G EXM
  1. S IOP="Q" S:ION]"" RADFLTP=ION
  1. K RAFL D Q^RAFLH,EXIT G DUP1
  1. ;
  1. SETVARS ; Setup key Rad/Nuc Med variables
  1. I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
  1. Q:'($D(RACCESS(DUZ))\10) ; user does not have location access
  1. I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT
  1. Q
  1. WARN1 W !?3,"An electronically filed report has already been entered for this case.",!?3,"Please use the 'Outside Report Entry/Edit' option to change or enter",!?3,"diagnostic code for this case.",!!
  1. Q