Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RARTE

RARTE.m

Go to the documentation of this file.
  1. RARTE ;HISC/FPT,GJC AISC/MJK,RMO-Edit/Delete Reports ;26 Oct 2018 12:43 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**18,34,45,56,99,47,124**;Mar 16, 1998;Build 4
  1. ;Supported IA #3544 ^VA(200,"ARC"
  1. ;Supported IA #10076 ^XUSEC(
  1. ;Supported IA #2056 ^GET1^DIQ
  1. ;Supported IA #10009 YN^DICN
  1. ; last modification by SS for P18 June 14,2000
  1. ;
  1. D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
  1. W !!?3,"Note: To enter receipt of OUTSIDE INTERPRETED REPORTS,",!?3,"please use the 'Outside Report/Entry Edit' option.",!
  1. N RAXIT,RADRS,RASUBY0 S RAXIT=0 ;RADRS=copy (1=diag, 2=resid,staff)
  1. I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D Q^RARTE4 QUIT
  1. ;
  1. ;1. DO NOT KILL the RASIG variable; the RASIG() array is needed in
  1. ; the edit template [RA REPORT EDIT] later
  1. ;2. The RAELESIG canNOT store file 74's ien, as no rpt has been picked
  1. ; from this call to ES^RASIGU
  1. ;
  1. I $D(^XUSEC("RA VERIFY",DUZ)),($$GET1^DIQ(200,DUZ_",",20.4)]""),($D(^VA(200,"ARC","R",DUZ))!($D(^VA(200,"ARC","S",DUZ)))) D Q:'$D(RAELESIG)
  1. . W ! D ES^RASIGU S:%=1 RAELESIG=""
  1. . K:'$D(RAELESIG) %,%W,%Y,%Y1,C,X,X1,X2
  1. . Q
  1. K RABTCH I $P(RAMDV,"^",13) D ASKBTCH^RARTE1 G Q1^RARTE4:X["^" D 1^RABTCH:"Yy"[$E(X) I '$D(RABTCH) W " ...no batch selected",!
  1. START K RAVER S RAVW="",RAREPORT=1 D ^RACNLU G Q^RARTE4:"^"[X
  1. S RASUBY0=Y(0) ; save value of y(0)
  1. G:$P(^RA(72,+RAST,0),"^",3)>0 DISPLAY
  1. I $D(^XUSEC("RA MGR",DUZ)) G DISPLAY
  1. G:$P(RAMDV,"^",22)=1 DISPLAY
  1. W $C(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!! D INCRPT^RARTE4 G START
  1. ;
  1. DISPLAY ; Display exam specific info, edit/enter the report
  1. N RA18EX S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM
  1. N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1. S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
  1. I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D D Q^RARTE4 QUIT
  1. . I $$USESSAN^RAHLRU1() W !!?2,"Case #: ",RACNDSP," for ",RANME S RAXIT=1
  1. . I '$$USESSAN^RAHLRU1() W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1
  1. . W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted"
  1. . W !?2,"by another user!",$C(7)
  1. . Q
  1. ;Lock case node so no one else can edit rpt pointer during this session
  1. S RAPNODE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"","
  1. S RAXIT=$$LOCK^RAUTL12(RAPNODE,RACNI) I RAXIT D INCRPT^RARTE4 G START
  1. S RAI="",$P(RAI,"-",80)="" W !,RAI
  1. W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN
  1. I $$USESSAN^RAHLRU1() W !?1,"Case No. : ",RACNDSP,?40,"Exm. St : ",$E($P($G(^RA(72,+RAST,0)),"^"),1,22),!?1,"Procedure: ",$E(RAPRC,1,45)
  1. I '$$USESSAN^RAHLRU1() W !?1,"Case No. : ",RACN,?18,"Exm. St: ",$E($P($G(^RA(72,+RAST,0)),"^"),1,12),?40,"Procedure : ",$E(RAPRC,1,25)
  1. ;check for contrast media; display if CM data exists (patch 45)
  1. S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
  1. D:$L(RACMDATA) CMEDIA(RACMDATA)
  1. K RACMDATA
  1. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN," Tech.Comment: ",15,70,-1,0) ;P18
  1. I RA18EX=-1 Q ;P18
  1. N RAPRTSET,RAMEMARR,RA1
  1. D EN2^RAUTL20(.RAMEMARR)
  1. I RAPRTSET D
  1. . S RA1=""
  1. . F S RA1=$O(RAMEMARR(RA1)) Q:RA1=""!(RA18EX=-1) I RA1'=RACNI D
  1. .. I $$USESSAN^RAHLRU1() W !,?1,"Case No. : ",$P(RAMEMARR(RA1),U)
  1. .. I '$$USESSAN^RAHLRU1() W !,?1,"Case No. : ",+RAMEMARR(RA1)
  1. .. I $$USESSAN^RAHLRU1() W:$P(RAMEMARR(RA1),"^",4)]"" ?40,"Exm. St : ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,22) W !?1,"Procedure: ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,45)
  1. .. I '$$USESSAN^RAHLRU1() W:$P(RAMEMARR(RA1),"^",4)]"" ?18,"Exm. St: ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,12) W ?40,"Procedure : ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,26)
  1. ..;check printset for contrast media; display if CM data exists
  1. ..S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RA1)
  1. ..D:$L(RACMDATA) CMEDIA(RACMDATA)
  1. ..K RACMDATA
  1. ..I $P(RAMEMARR(RA1),"^")["-" S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,$P($P(RAMEMARR(RA1),"^"),"-",3)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1
  1. ..I $P(RAMEMARR(RA1),"^")'["-" S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1 ;P18
  1. .. Q
  1. . Q
  1. SS1 I RA18EX=-1 Q ;P18
  1. 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)
  1. W !?1,"Req Phys : ",$E($S($D(^VA(200,+$P(Y(0),"^",14),0)):$P(^(0),"^"),1:""),1,25)
  1. ; p99: get pt sex and display pregnancy data
  1. I $$PTSEX^RAUTL8(RADFN)="F" D
  1. .N RA3,RAPCOMM S RA3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .S RAPCOMM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCOMM"))
  1. .W:$P(RA3,U,32)'="" !?1,"Pregnancy Screen: ",$S($P(RA3,"^",32)="y":"Patient answered yes",$P(RA3,"^",32)="n":"Patient answered no",$P(RA3,"^",32)="u":"Patient is unable to answer or is unsure",1:"")
  1. .W:$P(RA3,U,32)'="n"&$L(RAPCOMM) !?1,"Pregnancy Screen Comment: ",RAPCOMM
  1. S Y(0)=RASUBY0
  1. W !,RAI
  1. ;end p99
  1. I $D(^RARPT(+RARPT,0)) S RA1=$P(^(0),"^",5) I "^V^EF^"[("^"_RA1_"^") W !?3,$C(7),"Report has already been ",$S(RA1="V":"verified",1:"electronically filed"),! D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START
  1. ;Create new rpt, or skip to IN to edit existing report
  1. G IN^RARTE4:$D(^RARPT(+RARPT,0))
  1. G:'RAPRTSET NEW G:$P(^RA(72,+RAST,0),"^",3)>0 NEW
  1. ; case is part of a print set, AND is cancelled
  1. N RA2 S (RA1,RA2)=""
  1. F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" S:$P(RAMEMARR(RA1),"^",3)]"" RA2=$P(RAMEMARR(RA1),"^",3)
  1. G:RA2="" NEW
  1. W !!,$C(7),"Other cases of this cancelled case ",RACNDSP,"'s print set are entered in a report already",!!,"You may NOT create a new report for this cancelled case,",!,"but you may include this cancelled case in the existing report."
  1. W !!,"Do you want to include this cancelled case in the same report",!,"as the others in the print set ?"
  1. S %=2 D YN^DICN
  1. W:%>0 "...",$S(%=1:"Include",1:"Skip")," this case"
  1. P124 ;RA5P124 update: don't add an accession to OTHER CASE#
  1. ;that is the .01 value of the report record
  1. I %=1 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RA2,RARPT=RA2,RARPTN=$P(^RARPT(RARPT,0),"^"),RA1=RACN D
  1. .N RACCSTR S RACCSTR=$P(RARPTN,"-",1,($L(RARPTN,"-"))-1)_"-"_RACN
  1. .D:($D(^RARPT("B",RACCSTR,RARPT))=0) INSERT^RARTE2
  1. .Q
  1. ;end RA5P124 update
  1. D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START
  1. NEW G:'RAPRTSET NEW1
  1. L +^RADPT(RADFN,"DT",RADTI):0 G:$T NEW1
  1. W !!?10,$C(7),"** This case belongs to a printset,",?68,"**",!?10,"** and someone else is currently doing REPORT ENTRY/EDIT",?68,"**"
  1. W !?10,"** on another case for this same printset,",?68,"**",!?10,"** so you may not enter a new report.",?68,"**"
  1. H 2 D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START
  1. NEW1 ;
  1. I $L(RACNDSP,"-")>1 S RARPTN=RACNDSP
  1. I $L(RACNDSP,"-")<2 S RARPTN=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
  1. W !?3,"...report not entered for this exam...",!?10,"...will now initialize report entry..."
  1. S I=+$P(^RARPT(0),"^",3)
  1. G LOCK^RARTE4
  1. Q
  1. ;
  1. CMEDIA(X) ;check if contrast media is associated with the report (exam)
  1. ;variables assumed to exist X: the string of contrast media used
  1. ;delimited by the comma.
  1. N Y W !," Contrast :"
  1. F Y=1:1 Q:$P(X,", ",Y)="" W ?12,$P(X,", ",Y) W:$P(X,", ",Y+1)'="" !
  1. Q