RAEDPT.m

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

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