- RART ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ; Sep 11, 2023@13:51:55
- ;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82,56,97,206**;Mar 16, 1998;Build 8
- ;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
- ;p206/KLM - EXPRESSION field (#6) deprecated. Use DISPLAY TEXT field (#100)
- ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
- S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U)
- 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)
- . ;p206
- . ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
- . S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U)
- . 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRART 5305 printed Jan 18, 2025@03:40:13 Page 2
- RART ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ; Sep 11, 2023@13:51:55
- +1 ;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82,56,97,206**;Mar 16, 1998;Build 8
- +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 ;p206/KLM - EXPRESSION field (#6) deprecated. Use DISPLAY TEXT field (#100)
- +7 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
- +8 SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
- +9 if RATMP]""
- WRITE " (",RATMP,")"
- +10 if ($Y+6)>IOSL&('$DATA(RARTVERF))
- DO WAIT^RART1
- if X="^"!(X="T")!(X="P")
- QUIT
- +11 IF '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))
- WRITE !
- QUIT
- +12 WRITE !!?3,"Secondary Diagnostic Codes: "
- +13 SET RADXCODE=0
- +14 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
- +15 WRITE !?2,$PIECE(^RA(78.3,RADXCODE,0),U,1)
- +16 ;p206
- +17 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
- +18 SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
- +19 if RATMP]""
- WRITE " (",RATMP,")"
- End DoDot:1
- +20 WRITE !
- +21 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