- RAESO ;HISC/CAH,GJC AISC/SAW-Override Exam Status to Complete ;16 Jan 2018 9:30 AM
- ;;5.0;Radiology/Nuclear Medicine;**47,137**;Mar 16, 1998;Build 4
- ;Mass override exam status to complete - REMOVED P137 /KLM
- SINGLE ;Override Single Exam Status to 'COMPLETE'
- D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
- N RAXIT,RASAVDR S RAXIT=0 D CZECH Q:RAXIT
- S RAVW="" D ^RACNLU G EXIT1:"^"[X W ! S I="",$P(I,"-",80)="" W I
- N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
- I $$USESSAN^RAHLRU1() W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN,!?1,"Case No. : ",RACNDSP,?40,"Procedure : ",$E(RAPRC,1,25)
- I '$$USESSAN^RAHLRU1() W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN,!?1,"Case No. : ",RACN,?40,"Procedure : ",$E(RAPRC,1,25)
- W !?1,"Exam Date: ",RADATE,?40,"Technologist: " I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))>0,$D(^VA(200,+^($O(^(0)),0),0)) W $E($P(^(0),"^"),1,25)
- W !?40,"Req Phys : ",$E($S($D(^VA(200,+$P(Y(0),"^",14),0)):$P(^(0),"^"),1:""),1,25),! S I="",$P(I,"-",80)="" W I
- I $P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)'=$O(^RA(79.2,"B",RAIMGTY,0)) W !,"Sorry, your sign-on imaging type, ",RAIMGTY,!,"doesn't match the imaging type of this exam.",! G SINGLE
- I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"...exam 'cancelled' therefore override is not allowed." G SINGLE
- I $D(^RA(72,"AA",RAIMGTY,9,+RAST)) W !!?3,$C(7),"...exam is already 'complete'." G SINGLE
- ASKOVR R !!,"Are you sure? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G SINGLE:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to override exam status to 'COMPLETE', or 'NO' not to." G ASKOVR
- W !?3,"...will now attempt override..." S DA=RADFN,DIE="^RADPT(",DR="[RA OVERRIDE]",RASAVDR=DR D ^DIE K DE,DQ,DIE,DR I '$D(Y) W !?6,"...exam status is now '",$P(^RA(72,$O(^RA(72,"AA",RAIMGTY,9,0)),0),"^"),"'.",! D ^RAORDC K DR
- G SINGLE
- EXIT1 K %,%DT,%I,%X,%Y,D,D0,D1,D2,D3,DA,DI,DIC,J,POP,RADFN,RADIV,RADTI,RACNI
- K RANME,RASSN,RADATE,RADTE,RACN,RAHEAD,RAI,RAPRC,RAPIFN,RARPT,RAST,RAVW
- K W,X,XQUIT,Y,^TMP($J,"RAEX")
- Q
- CZECH ; Check for a 'Complete' exam status for a particular imaging type
- I '+$O(^RA(72,"AA",RAIMGTY,9,0)) D
- . S RAXIT=1
- . W !?5,"An Examination Status of 'Complete' must be defined for an"
- . W !?5,"Imaging Type of: "_RAIMGTY_". Please contact your"
- . W !?5,"Radiology/Nuclear Medicine ADPAC for further assistance.",$C(7)
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAESO 2451 printed Feb 19, 2025@00:01:18 Page 2
- RAESO ;HISC/CAH,GJC AISC/SAW-Override Exam Status to Complete ;16 Jan 2018 9:30 AM
- +1 ;;5.0;Radiology/Nuclear Medicine;**47,137**;Mar 16, 1998;Build 4
- +2 ;Mass override exam status to complete - REMOVED P137 /KLM
- SINGLE ;Override Single Exam Status to 'COMPLETE'
- +1 DO SET^RAPSET1
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +2 NEW RAXIT,RASAVDR
- SET RAXIT=0
- DO CZECH
- if RAXIT
- QUIT
- +3 SET RAVW=""
- DO ^RACNLU
- if "^"[X
- GOTO EXIT1
- WRITE !
- SET I=""
- SET $PIECE(I,"-",80)=""
- WRITE I
- +4 NEW RASSAN,RACNDSP
- SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- +5 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACN)
- +6 IF $$USESSAN^RAHLRU1()
- WRITE !?1,"Name : ",$EXTRACT(RANME,1,25),?40,"Pt ID : ",RASSN,!?1,"Case No. : ",RACNDSP,?40,"Procedure : ",$EXTRACT(RAPRC,1,25)
- +7 IF '$$USESSAN^RAHLRU1()
- WRITE !?1,"Name : ",$EXTRACT(RANME,1,25),?40,"Pt ID : ",RASSN,!?1,"Case No. : ",RACN,?40,"Procedure : ",$EXTRACT(RAPRC,1,25)
- +8 WRITE !?1,"Exam Date: ",RADATE,?40,"Technologist: "
- IF $ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))>0
- IF $DATA(^VA(200,+^($ORDER(^(0)),0),0))
- WRITE $EXTRACT($PIECE(^(0),"^"),1,25)
- +9 WRITE !?40,"Req Phys : ",$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(Y(0),"^",14),0)):$PIECE(^(0),"^"),1:""),1,25),!
- SET I=""
- SET $PIECE(I,"-",80)=""
- WRITE I
- +10 IF $PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),U,2)'=$ORDER(^RA(79.2,"B",RAIMGTY,0))
- WRITE !,"Sorry, your sign-on imaging type, ",RAIMGTY,!,"doesn't match the imaging type of this exam.",!
- GOTO SINGLE
- +11 IF $DATA(^RA(72,"AA",RAIMGTY,0,+RAST))
- WRITE !!?3,$CHAR(7),"...exam 'cancelled' therefore override is not allowed."
- GOTO SINGLE
- +12 IF $DATA(^RA(72,"AA",RAIMGTY,9,+RAST))
- WRITE !!?3,$CHAR(7),"...exam is already 'complete'."
- GOTO SINGLE
- ASKOVR READ !!,"Are you sure? No// ",X:DTIME
- if '$TEST!(X="")!(X["^")
- SET X="N"
- if "Nn"[$EXTRACT(X)
- GOTO SINGLE
- IF "Yy"'[$EXTRACT(X)
- if X'["?"
- WRITE $CHAR(7)
- WRITE !!?3,"Enter 'YES' to override exam status to 'COMPLETE', or 'NO' not to."
- GOTO ASKOVR
- +1 WRITE !?3,"...will now attempt override..."
- SET DA=RADFN
- SET DIE="^RADPT("
- SET DR="[RA OVERRIDE]"
- SET RASAVDR=DR
- DO ^DIE
- KILL DE,DQ,DIE,DR
- IF '$DATA(Y)
- WRITE !?6,"...exam status is now '",$PIECE(^RA(72,$ORDER(^RA(72,"AA",RAIMGTY,9,0)),0),"^"),"'.",!
- DO ^RAORDC
- KILL DR
- +2 GOTO SINGLE
- EXIT1 KILL %,%DT,%I,%X,%Y,D,D0,D1,D2,D3,DA,DI,DIC,J,POP,RADFN,RADIV,RADTI,RACNI
- +1 KILL RANME,RASSN,RADATE,RADTE,RACN,RAHEAD,RAI,RAPRC,RAPIFN,RARPT,RAST,RAVW
- +2 KILL W,X,XQUIT,Y,^TMP($JOB,"RAEX")
- +3 QUIT
- CZECH ; Check for a 'Complete' exam status for a particular imaging type
- +1 IF '+$ORDER(^RA(72,"AA",RAIMGTY,9,0))
- Begin DoDot:1
- +2 SET RAXIT=1
- +3 WRITE !?5,"An Examination Status of 'Complete' must be defined for an"
- +4 WRITE !?5,"Imaging Type of: "_RAIMGTY_". Please contact your"
- +5 WRITE !?5,"Radiology/Nuclear Medicine ADPAC for further assistance.",$CHAR(7)
- +6 QUIT
- End DoDot:1
- +7 QUIT