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