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 ;1/11/02  11:15
  1.  ;;5.0;Radiology/Nuclear Medicine;**5,13,10,18,28,31,34,45,85,97**;Mar 16, 1998;Build 6
  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 Q:X="^"
  1.  I RADR="[RA DIAGNOSTIC BY CASE]" D  I RAERR R !?5,"Press RETURN to exit:",RAXIT:DTIME G Q
  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. Q 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
  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 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
  1.  S RAXIT=$$CKREASON^RAEDCN1("C") I RAXIT K RAXIT Q  ;P18
  1.  D ^RACNLU G Q:X="^" I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !?3,$C(7),"This exam has already been cancelled!" G Q
  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 Q
  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) Q 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,1,2)_"-"_RACN
  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.  I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore cancellation is not allowed!" G Q
  1. ASKCAN R !!,"Do you wish to cancel this exam now? NO// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel this exam, or 'NO' not to." G ASKCAN
  1.  N REM ;used for remarks within edit template
  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 Q
  1.  S DA=RADFN,DR="[RA CANCEL]",DIE="^RADPT(" D ^DIE K DE,DQ,DIE,DR
  1.  K RADTE,RACN,RAPOP,RADUZ ;moved from edit template
  1. PACS I '$D(Y),$D(RAFIN) W !?10,"...cancellation complete." D DELPNT^RAUTL20(RADFN,RADTI,RACNI),^RAORDC,CANCEL^RAHLRPC
  1.  L -^RADPT(RADFN)
  1.  G Q
  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 Q:X="^"
  1.  G Q:'$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 Q 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 Q:'$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,Q 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