RAEDPT ;HISC/FPT,GJC,SS AISC/MJK,RMO-Edit Exams by Patient ;4/21/97 10:47
;;5.0;Radiology/Nuclear Medicine;**10,18,28,45,47**;Mar 16, 1998;Build 21
;last modification by SS JUNE 19,2000
CASE D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
S RAXIT=0,DIC(0)="AEMQ" D ^RADPA G Q:Y<0
S RADFN=+Y,RAHEAD="**** Edit Exams By Patient ****"
D ^RAPTLU G CASE:"^"[X
N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
I $$USESSAN^RAHLRU1() W !!?5,"Case No.: ",RACNDSP,!?4,"Procedure: ",$E(RAPRC,1,30),?56,"Date: ",RADATE
I '$$USESSAN^RAHLRU1() W !!,"Case No.:",RACN,?15,"Procedure:",$E(RAPRC,1,30),?57,"Date:",RADATE
N RADISPLY
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
S RADISPLY=$$PRCCPT^RADD1()
W !,?25,RADISPLY
I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",DUZ)) W !!?3,$C(7),"You do not have the appropriate access privilege to edit completed exams.",! G CASE
I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore it cannot be edited." G CASE
S RAQUICK=0,DA=RADFN,DIE("NO^")="OUTOK"
S RADADA=RADTI ; RADTI defined in ^RAPTLU
S DIE="^RADPT(",DR="[RA EXAM EDIT]"
S RADIE="^RADPT("_RADFN_",""DT"","
S RAXIT=$$LOCK^RAUTL12(RADIE,RADADA) I RAXIT G CASE
N RAREM,RANUZD1,RAPSDRUG,RA00,RADIOPH,RALOW,RAHI,RADRAWN,RAASK,RADOSE,RASKMEDS,RAWHICH ;these are used by the edit template
;
;save 'before' CM data value to compare against the possible 'after'
;value
D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB) ;RA*5*45
;
D SVBEFOR^RAO7XX(RADFN,RADTI,RACNI) ;P18 save before edit to compare later in RAUTL1
D ^DIE K DE,DQ,DIE,DR,RAZCM
S:$D(RAPRI) RAPRIT=RAPRI D UP1^RAUTL1
;
;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST
;MEDIA'
;2) check 'before' CM data against 'after' CM data, file in audit log
;if necessary. Remember, contrast media asked when in input template:
;RA EXAM EDIT (RA*5*45)
S RACMDA=RACNI,RACMDA(1)=RADTI,RACMDA(2)=RADFN
D XCMINTEG^RAMAINU1(.RACMDA) ;1
D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB) ;2
K RACMDA
;
D UNLOCK^RAUTL12(RADIE,RADADA) ;modif P18 by SS
K RATRKCMB,RADADA,RADIE,RADUZ W ! G CASE ;modif P18 by SS
;
Q K %,%DT,%Y,A,C,D0,D1,D2,DA,DIC,I,RACN,RACNI,RACNT,RACT,RADADA,RADATE,RADATI,RADFN,RADIE,RADTE,RADTI,RAHEAD,RAMES,RANME,RAOR,RAORDIFN,RAPOP,RAPRC,RAPRI,RAQUICK,RARPT,RASN,RASSN,RAST,RASTI,RAXIT,XQUIT,VAINDT,VADMVT,X,Y
K ^TMP($J,"RAEX")
K %W,%Y1,D,D3,DDER,DI,DK,DL,POP,DISYS,DUOUT,RAI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAEDPT 2616 printed Dec 13, 2024@02:34:58 Page 2
RAEDPT ;HISC/FPT,GJC,SS AISC/MJK,RMO-Edit Exams by Patient ;4/21/97 10:47
+1 ;;5.0;Radiology/Nuclear Medicine;**10,18,28,45,47**;Mar 16, 1998;Build 21
+2 ;last modification by SS JUNE 19,2000
CASE DO SET^RAPSET1
IF $DATA(XQUIT)
KILL XQUIT,POP
QUIT
+1 SET RAXIT=0
SET DIC(0)="AEMQ"
DO ^RADPA
if Y<0
GOTO Q
+2 SET RADFN=+Y
SET RAHEAD="**** Edit Exams By Patient ****"
+3 DO ^RAPTLU
if "^"[X
GOTO CASE
+4 NEW RASSAN,RACNDSP
SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+5 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACN)
+6 IF $$USESSAN^RAHLRU1()
WRITE !!?5,"Case No.: ",RACNDSP,!?4,"Procedure: ",$EXTRACT(RAPRC,1,30),?56,"Date: ",RADATE
+7 IF '$$USESSAN^RAHLRU1()
WRITE !!,"Case No.:",RACN,?15,"Procedure:",$EXTRACT(RAPRC,1,30),?57,"Date:",RADATE
+8 NEW RADISPLY
+9 ; set $ZR to 71 for prccpt^radd1, not call raprod since diff col
SET RADISPLY=$GET(^RAMIS(71,+$PIECE($GET(^RADPT(+RADFN,"DT",+RADTI,"P",+RACNI,0)),U,2),0))
+10 SET RADISPLY=$$PRCCPT^RADD1()
+11 WRITE !,?25,RADISPLY
+12 IF $DATA(^RA(72,"AA",RAIMGTY,9,+RAST))
IF '$DATA(^XUSEC("RA MGR",DUZ))
WRITE !!?3,$CHAR(7),"You do not have the appropriate access privilege to edit completed exams.",!
GOTO CASE
+13 IF $DATA(^RA(72,"AA",RAIMGTY,0,+RAST))
WRITE !!?3,$CHAR(7),"Exam has been 'cancelled' therefore it cannot be edited."
GOTO CASE
+14 SET RAQUICK=0
SET DA=RADFN
SET DIE("NO^")="OUTOK"
+15 ; RADTI defined in ^RAPTLU
SET RADADA=RADTI
+16 SET DIE="^RADPT("
SET DR="[RA EXAM EDIT]"
+17 SET RADIE="^RADPT("_RADFN_",""DT"","
+18 SET RAXIT=$$LOCK^RAUTL12(RADIE,RADADA)
IF RAXIT
GOTO CASE
+19 ;these are used by the edit template
NEW RAREM,RANUZD1,RAPSDRUG,RA00,RADIOPH,RALOW,RAHI,RADRAWN,RAASK,RADOSE,RASKMEDS,RAWHICH
+20 ;
+21 ;save 'before' CM data value to compare against the possible 'after'
+22 ;value
+23 ;RA*5*45
DO TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB)
+24 ;
+25 ;P18 save before edit to compare later in RAUTL1
DO SVBEFOR^RAO7XX(RADFN,RADTI,RACNI)
+26 DO ^DIE
KILL DE,DQ,DIE,DR,RAZCM
+27 if $DATA(RAPRI)
SET RAPRIT=RAPRI
DO UP1^RAUTL1
+28 ;
+29 ;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST
+30 ;MEDIA'
+31 ;2) check 'before' CM data against 'after' CM data, file in audit log
+32 ;if necessary. Remember, contrast media asked when in input template:
+33 ;RA EXAM EDIT (RA*5*45)
+34 SET RACMDA=RACNI
SET RACMDA(1)=RADTI
SET RACMDA(2)=RADFN
+35 ;1
DO XCMINTEG^RAMAINU1(.RACMDA)
+36 ;2
DO TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB)
+37 KILL RACMDA
+38 ;
+39 ;modif P18 by SS
DO UNLOCK^RAUTL12(RADIE,RADADA)
+40 ;modif P18 by SS
KILL RATRKCMB,RADADA,RADIE,RADUZ
WRITE !
GOTO CASE
+41 ;
Q KILL %,%DT,%Y,A,C,D0,D1,D2,DA,DIC,I,RACN,RACNI,RACNT,RACT,RADADA,RADATE,RADATI,RADFN,RADIE,RADTE,RADTI,RAHEAD,RAMES,RANME,RAOR,RAORDIFN,RAPOP,RAPRC,RAPRI,RAQUICK,RARPT,RASN,RASSN,RAST,RASTI,RAXIT,XQUIT,VAINDT,VADMVT,X,Y
+1 KILL ^TMP($JOB,"RAEX")
+2 KILL %W,%Y1,D,D3,DDER,DI,DK,DL,POP,DISYS,DUOUT,RAI
+3 QUIT
