RART ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ;11/16/98 15:02
;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82,56,97**;Mar 16, 1998;Build 6
;Supported IA #1571 ^LEX(757.01
;Private IA #4793 CREATE^WVRALINK
;Supoprted IA #3544 ^VA(200,"ARC"
;;last modification by SS for P18 June 15, 2000
3 ;;Verify a Report
N I5
D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D Q QUIT
G:$D(^VA(200,"ARC","S",DUZ))!($D(^XUSEC("RA VERIFY",DUZ))) 30
G:$P(RAMDV,"^",18)=1 30
G:'$D(^VA(200,"ARC","R",DUZ)) 30
I $P(RAMDV,"^",18)'=1 W !!,$C(7),"Interpreting Residents are not allowed to verify reports." G Q
30 K RAUP S RAPGM=30,RAREPORT=1 D ^RACNLU G Q:X="^" I '$D(^RARPT(+RARPT,0)) W !!?2,$C(7),"No report available!" G 30
S I5=$P(^RARPT(+RARPT,0),"^",5) I "^V^EF^"[("^"_I5_"^") W !!?2,$C(7),"Report already ",$S(I5="V":"verified",1:"electronically filed") G 30
SS1 Q:$$VERONLY^RAUTL11=-1 ;P18 case info
31 S DIE("NO^")="",DA=RARPT,DR="[RA VERIFY REPORT ONLY]",DIE="^RARPT("
S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U)
I RAIMGTYJ']"" W !,"Error: Cannot determine imaging type of exam.",! K RAIMGTYI,RAIMGTYJ G @RAPGM
; must lock both report AND case together, so to ensure
; that a verified report has the correct diagnostic codes
S RAXIT=$$LOCK^RAUTL12(DIE,DA) ; lock Report
I RAXIT K RAXIT G @RAPGM
S RASAVDIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",RASAVDA(2)=RADFN,RASAVDA(1)=RADTI,RASAVDA=RACNI
; rpt exists & locked, thus no need to lock at "DT" level because users
; can only use 'report entry/edit' option to enter dx's for printsets
S RAXIT=$$LOCK^RAUTL12(RASAVDIE,.RASAVDA) ; lock case before asking REPORT STATUS
I RAXIT K RAXIT G @RAPGM
D ^DIE K DE,DQ,DR D UNLOCK^RAUTL12(DIE,DA) ; unlock Report
K DIE,RAXIT
S X=+$O(^RA(72,"AA",RAIMGTYJ,9,0)),DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
S DR=13_$S(RACT'="V":"",'$D(^RA(72,X,.1)):"",$P(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1 "
I RACT="V",($P($G(^RA(72,+X,.1)),"^",5)="Y") S DIE("NO^")="BACK"
D ^DIE
K DA,DE,DQ,DIE,DR
I $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)="" G UNL31
S DR="50///"_RACN
S DR(2,70.03)=13.1
S DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1"
S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
D ^DIE
UNL31 ; copy then unlock
N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
D EN2^RAUTL20(.RAMEMARR)
I RAPRTSET S RADRS=1,RAXIT=0 D COPY^RARTE2 ; copy diagnoses
D UNLOCK^RAUTL12(RASAVDIE,.RASAVDA) ; use params from PrimDiag's lock
K RASAVDIE,RASAVDA
K DA,DE,DQ,DIE,DR
32 K RAXIT
I $G(RAPGM)="GETRPT^RARTVER" I $E(RACT'="V"),($P(^RARPT(RARPT,0),U,14)]"") D RETURN^RARTVER2
PACS I (RACT="V")!(RACT="R") D TASK^RAHLO4
I "^V^EF^"[("^"_RACT_"^"),$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ;women's health
;
I RAPGM="NXT^RABTCH1" G @RAPGM
TIME D:RACT="V"
.N RAHLTCPB S RAHLTCPB=1 D UPSTAT^RAUTL0 K RAAB
I $G(RARDX)="S" D
. D SAVE^RARTVER2
. I $G(RAPGM)="GETRPT^RARTVER" D
.. ; for 'On-line Verifying of Reports' default device selection is the
.. ; "REPORT PRINTER NAME"
.. S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
.. Q
. D Q^RARTR,RESTORE^RARTVER2
. K:$D(%ZIS("B")) %ZIS("B")
. Q
G @RAPGM
Q K %,%DT,%X,C,D,D0,D1,DA,DIC,RACN,RACNI,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAHEAD,RAI,RAIMGTYI,RAIMGTYJ,RANME,RANUM,RAOR,RAPGM,RAPRC,RAQUIT,RAREPORT,RARPT,RASET,RASN,RASSN,RAST,RASTI,RAUP,RAVER,X,Y,^TMP($J,"RAEX")
K %W,%Y,%Y1,DDER,DI,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,RACI,ZTSK,POP,DDH
Q
OERR1 ; Jump to 'OERR1^RART1' This is necessary to support the reference to
; this line label in the OE/RR Notifications file.
G OERR1^RART1 Q
;
PRTDX ; print dx codes on report display (called from RART1)
N RATMP
K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF))
Q:X="^"!(X="T")!(X="P")
S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
W !?3,"Primary Diagnostic Code: ",!?2,$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"") K RAFLG
S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
W:RATMP]"" " (",RATMP,")"
D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P")
I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) W ! Q
W !!?3,"Secondary Diagnostic Codes: "
S RADXCODE=0
F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0!('$D(^RA(78.3,+RADXCODE,0)))!($D(RAOOUT)) K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P") D
. W !?2,$P(^RA(78.3,RADXCODE,0),U,1)
. S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
. W:RATMP]"" " (",RATMP,")"
W !
Q
EXIT ; Kill variables created when user prints 'Abnormal Rad/Nuc Med Report
; Alert'. Variables are created when 'PRT^RARTR' is called.
K %X,%XX,%Y,%YY,A,DDER,DFN,DI,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DLAYGO
K DN,RACI,RACN0,RACPT,RACPTNDE,RADTE0,RADTV,RAN,RAOBR4,RAPRCNDE
K RAPROC,RAPROCIT,RAPRV,RARPT0,VA,VADM,VAERR,X2,ZTSK
Q
RART ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ;11/16/98 15:02
+1 ;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82,56,97**;Mar 16, 1998;Build 6
+2 ;Supported IA #1571 ^LEX(757.01
+3 ;Private IA #4793 CREATE^WVRALINK
+4 ;Supoprted IA #3544 ^VA(200,"ARC"
+5 ;;last modification by SS for P18 June 15, 2000
3 ;;Verify a Report
+1 NEW I5
+2 DO SET^RAPSET1
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+3 IF $DATA(RANOSCRN)
SET X=$$DIVLOC^RAUTL7()
IF X
DO Q
QUIT
+4 IF $DATA(^VA(200,"ARC","S",DUZ))!($DATA(^XUSEC("RA VERIFY",DUZ)))
GOTO 30
+5 IF $PIECE(RAMDV,"^",18)=1
GOTO 30
+6 IF '$DATA(^VA(200,"ARC","R",DUZ))
GOTO 30
+7 IF $PIECE(RAMDV,"^",18)'=1
WRITE !!,$CHAR(7),"Interpreting Residents are not allowed to verify reports."
GOTO Q
30 KILL RAUP
SET RAPGM=30
SET RAREPORT=1
DO ^RACNLU
IF X="^"
GOTO Q
IF '$DATA(^RARPT(+RARPT,0))
WRITE !!?2,$CHAR(7),"No report available!"
GOTO 30
+1 SET I5=$PIECE(^RARPT(+RARPT,0),"^",5)
IF "^V^EF^"[("^"_I5_"^")
WRITE !!?2,$CHAR(7),"Report already ",$SELECT(I5="V":"verified",1:"electronically filed")
GOTO 30
SS1 ;P18 case info
IF $$VERONLY^RAUTL11=-1
QUIT
31 SET DIE("NO^")=""
SET DA=RARPT
SET DR="[RA VERIFY REPORT ONLY]"
SET DIE="^RARPT("
+1 SET RAIMGTYI=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,0)),U,2)
SET RAIMGTYJ=$PIECE($GET(^RA(79.2,+RAIMGTYI,0)),U)
+2 IF RAIMGTYJ']""
WRITE !,"Error: Cannot determine imaging type of exam.",!
KILL RAIMGTYI,RAIMGTYJ
GOTO @RAPGM
+3 ; must lock both report AND case together, so to ensure
+4 ; that a verified report has the correct diagnostic codes
+5 ; lock Report
SET RAXIT=$$LOCK^RAUTL12(DIE,DA)
+6 IF RAXIT
KILL RAXIT
GOTO @RAPGM
+7 SET RASAVDIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","
SET RASAVDA(2)=RADFN
SET RASAVDA(1)=RADTI
SET RASAVDA=RACNI
+8 ; rpt exists & locked, thus no need to lock at "DT" level because users
+9 ; can only use 'report entry/edit' option to enter dx's for printsets
+10 ; lock case before asking REPORT STATUS
SET RAXIT=$$LOCK^RAUTL12(RASAVDIE,.RASAVDA)
+11 IF RAXIT
KILL RAXIT
GOTO @RAPGM
+12 ; unlock Report
DO ^DIE
KILL DE,DQ,DR
DO UNLOCK^RAUTL12(DIE,DA)
+13 KILL DIE,RAXIT
+14 SET X=+$ORDER(^RA(72,"AA",RAIMGTYJ,9,0))
SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
SET DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
+15 SET DR=13_$SELECT(RACT'="V":"",'$DATA(^RA(72,X,.1)):"",$PIECE(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1 "
+16 IF RACT="V"
IF ($PIECE($GET(^RA(72,+X,.1)),"^",5)="Y")
SET DIE("NO^")="BACK"
+17 DO ^DIE
+18 KILL DA,DE,DQ,DIE,DR
+19 IF $PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)=""
GOTO UNL31
+20 SET DR="50///"_RACN
+21 SET DR(2,70.03)=13.1
+22 SET DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1"
+23 SET DA(1)=RADFN
SET DA=RADTI
SET DIE="^RADPT("_DA(1)_",""DT"","
+24 DO ^DIE
UNL31 ; copy then unlock
+1 IF '$DATA(RAPRTSET)
NEW RAPRTSET
IF '$DATA(RAMEMARR)
NEW RAMEMARR
+2 DO EN2^RAUTL20(.RAMEMARR)
+3 ; copy diagnoses
IF RAPRTSET
SET RADRS=1
SET RAXIT=0
DO COPY^RARTE2
+4 ; use params from PrimDiag's lock
DO UNLOCK^RAUTL12(RASAVDIE,.RASAVDA)
+5 KILL RASAVDIE,RASAVDA
+6 KILL DA,DE,DQ,DIE,DR
32 KILL RAXIT
+1 IF $GET(RAPGM)="GETRPT^RARTVER"
IF $EXTRACT(RACT'="V")
IF ($PIECE(^RARPT(RARPT,0),U,14)]"")
DO RETURN^RARTVER2
PACS IF (RACT="V")!(RACT="R")
DO TASK^RAHLO4
+1 ;women's health
IF "^V^EF^"[("^"_RACT_"^")
IF $TEXT(CREATE^WVRALINK)]""
DO CREATE^WVRALINK(RADFN,RADTI,RACNI)
+2 ;
+3 IF RAPGM="NXT^RABTCH1"
GOTO @RAPGM
TIME IF RACT="V"
Begin DoDot:1
+1 NEW RAHLTCPB
SET RAHLTCPB=1
DO UPSTAT^RAUTL0
KILL RAAB
End DoDot:1
+2 IF $GET(RARDX)="S"
Begin DoDot:1
+3 DO SAVE^RARTVER2
+4 IF $GET(RAPGM)="GETRPT^RARTVER"
Begin DoDot:2
+5 ; for 'On-line Verifying of Reports' default device selection is the
+6 ; "REPORT PRINTER NAME"
+7 SET %ZIS("B")=$PIECE($GET(RAMLC),"^",10)
IF %ZIS("B")']""
KILL %ZIS("B")
+8 QUIT
End DoDot:2
+9 DO Q^RARTR
DO RESTORE^RARTVER2
+10 IF $DATA(%ZIS("B"))
KILL %ZIS("B")
+11 QUIT
End DoDot:1
+12 GOTO @RAPGM
Q KILL %,%DT,%X,C,D,D0,D1,DA,DIC,RACN,RACNI,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAHEAD,RAI,RAIMGTYI,RAIMGTYJ,RANME,RANUM,RAOR,RAPGM,RAPRC,RAQUIT,RAREPORT,RARPT,RASET,RASN,RASSN,RAST,RASTI,RAUP,RAVER,X,Y,^TMP($JOB,"RAEX")
+1 KILL %W,%Y,%Y1,DDER,DI,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,RACI,ZTSK,POP,DDH
+2 QUIT
OERR1 ; Jump to 'OERR1^RART1' This is necessary to support the reference to
+1 ; this line label in the OE/RR Notifications file.
+2 GOTO OERR1^RART1
QUIT
+3 ;
PRTDX ; print dx codes on report display (called from RART1)
+1 NEW RATMP
+2 KILL RAFLG
IF ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
+3 IF X="^"!(X="T")!(X="P")
QUIT
+4 SET RADXCODE=$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
+5 WRITE !?3,"Primary Diagnostic Code: ",!?2,$SELECT($DATA(^RA(78.3,+RADXCODE,0)):$PIECE(^(0),U,1),1:"")
KILL RAFLG
+6 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+7 IF RATMP]""
WRITE " (",RATMP,")"
+8 IF ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
IF X="^"!(X="T")!(X="P")
QUIT
+9 IF '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))
WRITE !
QUIT
+10 WRITE !!?3,"Secondary Diagnostic Codes: "
+11 SET RADXCODE=0
+12 FOR
SET RADXCODE=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE))
IF RADXCODE'>0!('$DATA(^RA(78.3,+RADXCODE,0)))!($DATA(RAOOUT))
QUIT
KILL RAFLG
IF ($Y+6)>IOSL&('$DATA(RARTVERF))
DO WAIT^RART1
IF X="^"!(X="T")!(X="P")
QUIT
Begin DoDot:1
+13 WRITE !?2,$PIECE(^RA(78.3,RADXCODE,0),U,1)
+14 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+15 IF RATMP]""
WRITE " (",RATMP,")"
End DoDot:1
+16 WRITE !
+17 QUIT
EXIT ; Kill variables created when user prints 'Abnormal Rad/Nuc Med Report
+1 ; Alert'. Variables are created when 'PRT^RARTR' is called.
+2 KILL %X,%XX,%Y,%YY,A,DDER,DFN,DI,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DLAYGO
+3 KILL DN,RACI,RACN0,RACPT,RACPTNDE,RADTE0,RADTV,RAN,RAOBR4,RAPRCNDE
+4 KILL RAPROC,RAPROCIT,RAPRV,RARPT0,VA,VADM,VAERR,X2,ZTSK
+5 QUIT
