- 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 Feb 19, 2025@00:01:14 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