- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTE.m
r613 r623 1 RARTE ;HISC/FPT,GJC AISC/MJK,RMO-Edit/Delete Reports ;8/4/97 09:09 2 ;;5.0;Radiology/Nuclear Medicine;**18,34,45,56**;Mar 16, 1998;Build 3 3 ;Supported IA #3544 ^VA(200,"ARC" 4 ;Supported IA #10076 ^XUSEC( 5 ;Supported IA #2056 ^GET1^DIQ 6 ;Supported IA #10009 YN^DICN 7 ; last modification by SS for P18 June 14,2000 8 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 9 W !!?3,"Note: To enter receipt of OUTSIDE INTERPRETED REPORTS,",!?3,"please use the 'Outside Report/Entry Edit' option.",! 10 N RAXIT,RADRS,RASUBY0 S RAXIT=0 ;RADRS=copy (1=diag, 2=resid,staff) 11 I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D 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 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) 19 . W ! D ES^RASIGU S:%=1 RAELESIG="" 20 . K:'$D(RAELESIG) %,%W,%Y,%Y1,C,X,X1,X2 21 . Q 22 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",! 23 START K RAVER S RAVW="",RAREPORT=1 D ^RACNLU G Q^RARTE4:"^"[X 24 S RASUBY0=Y(0) ; save value of y(0) 25 G:$P(^RA(72,+RAST,0),"^",3)>0 DISPLAY 26 I $D(^XUSEC("RA MGR",DUZ)) G DISPLAY 27 G:$P(RAMDV,"^",22)=1 DISPLAY 28 W $C(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!! D INCRPT^RARTE4 G START 29 ; 30 DISPLAY ; Display exam specific info, edit/enter the report 31 N RA18EX S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM 32 I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D D Q^RARTE4 QUIT 33 . W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1 34 . W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted" 35 . W !?2,"by another user!",$C(7) 36 . Q 37 ;Lock case node so no one else can edit rpt pointer during this session 38 S RAPNODE="^RADPT("_RADFN_",""DT"","_RADTI_",""P""," 39 S RAXIT=$$LOCK^RAUTL12(RAPNODE,RACNI) I RAXIT D INCRPT^RARTE4 G START 40 S RAI="",$P(RAI,"-",80)="" W !,RAI 41 W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN 42 W !?1,"Case No. : ",RACN,?18,"Exm. St: ",$E($P($G(^RA(72,+RAST,0)),"^"),1,12),?40,"Procedure : ",$E(RAPRC,1,25) 43 ;check for contrast media; display if CM data exists (patch 45) 44 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI) 45 D:$L(RACMDATA) CMEDIA(RACMDATA) 46 K RACMDATA 47 S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN," Tech.Comment: ",15,70,-1,0) ;P18 48 I RA18EX=-1 Q ;P18 49 N RAPRTSET,RAMEMARR,RA1 50 D EN2^RAUTL20(.RAMEMARR) 51 I RAPRTSET D 52 . S RA1="" 53 . F S RA1=$O(RAMEMARR(RA1)) Q:RA1=""!(RA18EX=-1) I RA1'=RACNI D 54 .. W !,?1,"Case No. : ",+RAMEMARR(RA1) 55 .. W:$P(RAMEMARR(RA1),"^",4)]"" ?18,"Exm. St: ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,12) 56 .. W ?40,"Procedure : ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,26) 57 ..;check printset for contrast media; display if CM data exists 58 ..S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RA1) 59 ..D:$L(RACMDATA) CMEDIA(RACMDATA) 60 ..K RACMDATA 61 .. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1 ;P18 62 .. Q 63 . Q 64 SS1 I RA18EX=-1 Q ;P18 65 S Y(0)=RASUBY0 66 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) 67 W !?40,"Req Phys : ",$E($S($D(^VA(200,+$P(Y(0),"^",14),0)):$P(^(0),"^"),1:""),1,25),!,RAI 68 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 69 ;Create new rpt, or skip to IN to edit existing report 70 G IN^RARTE4:$D(^RARPT(+RARPT,0)) 71 G:'RAPRTSET NEW G:$P(^RA(72,+RAST,0),"^",3)>0 NEW 72 ; case is part of a print set, AND is cancelled 73 N RA2 S (RA1,RA2)="" 74 F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" S:$P(RAMEMARR(RA1),"^",3)]"" RA2=$P(RAMEMARR(RA1),"^",3) 75 G:RA2="" NEW 76 W !!,$C(7),"Other cases of this cancelled case ",RACN,"'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." 77 W !!,"Do you want to include this cancelled case in the same report",!,"as the others in the print set ?" 78 S %=2 D YN^DICN 79 W:%>0 "...",$S(%=1:"Include",1:"Skip")," this case" 80 I %=1 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RA2,RARPT=RA2,RARPTN=$P(^RARPT(RARPT,0),"^"),RA1=RACN D INSERT^RARTE2 81 D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START 82 NEW G:'RAPRTSET NEW1 83 L +^RADPT(RADFN,"DT",RADTI):0 G:$T NEW1 84 W !!?10,$C(7),"** This case belongs to a printset,",?68,"**",!?10,"** and someone else is currently doing REPORT ENTRY/EDIT",?68,"**" 85 W !?10,"** on another case for this same printset,",?68,"**",!?10,"** so you may not enter a new report.",?68,"**" 86 H 2 D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START 87 NEW1 S RARPTN=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN 88 W !?3,"...report not entered for this exam...",!?10,"...will now initialize report entry..." 89 S I=+$P(^RARPT(0),"^",3) 90 G LOCK^RARTE4 91 Q 92 ; 93 CMEDIA(X) ;check if contrast media is associated with the report (exam) 94 ;variables assumed to exist X: the string of contrast media used 95 ;delimited by the comma. 96 N Y W !," Contrast :" 97 F Y=1:1 Q:$P(X,", ",Y)="" W ?12,$P(X,", ",Y) W:$P(X,", ",Y+1)'="" ! 98 Q 1 RARTE ;HISC/FPT,GJC AISC/MJK,RMO-Edit/Delete Reports ;8/4/97 09:09 2 ;;5.0;Radiology/Nuclear Medicine;**18,34,45**;Mar 16, 1998 3 ; last modification by SS for P18 June 14,2000 4 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 5 N RAXIT,RADRS,RASUBY0 S RAXIT=0 ;RADRS=copy (1=diag, 2=resid,staff) 6 I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D Q^RARTE4 QUIT 7 ; 8 ;1. DO NOT KILL the RASIG variable; the RASIG() array is needed in 9 ; the edit template [RA REPORT EDIT] later 10 ;2. The RAELESIG canNOT store file 74's ien, as no rpt has been picked 11 ; from this call to ES^RASIGU 12 ; 13 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) 14 . W ! D ES^RASIGU S:%=1 RAELESIG="" 15 . K:'$D(RAELESIG) %,%W,%Y,%Y1,C,X,X1,X2 16 . Q 17 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",! 18 START K RAVER S RAVW="",RAREPORT=1 D ^RACNLU G Q^RARTE4:"^"[X 19 S RASUBY0=Y(0) ; save value of y(0) 20 G:$P(^RA(72,+RAST,0),"^",3)>0 DISPLAY 21 I $D(^XUSEC("RA MGR",DUZ)) G DISPLAY 22 G:$P(RAMDV,"^",22)=1 DISPLAY 23 W $C(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!! D INCRPT^RARTE4 G START 24 ; 25 DISPLAY ; Display exam specific info, edit/enter the report 26 N RA18EX S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM 27 I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D D Q^RARTE4 QUIT 28 . W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1 29 . W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted" 30 . W !?2,"by another user!",$C(7) 31 . Q 32 ;Lock case node so no one else can edit rpt pointer during this session 33 S RAPNODE="^RADPT("_RADFN_",""DT"","_RADTI_",""P""," 34 S RAXIT=$$LOCK^RAUTL12(RAPNODE,RACNI) I RAXIT D INCRPT^RARTE4 G START 35 S RAI="",$P(RAI,"-",80)="" W !,RAI 36 W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN 37 W !?1,"Case No. : ",RACN,?18,"Exm. St: ",$E($P($G(^RA(72,+RAST,0)),"^"),1,12),?40,"Procedure : ",$E(RAPRC,1,25) 38 ;check for contrast media; display if CM data exists (patch 45) 39 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI) 40 D:$L(RACMDATA) CMEDIA(RACMDATA) 41 K RACMDATA 42 S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN," Tech.Comment: ",15,70,-1,0) ;P18 43 I RA18EX=-1 Q ;P18 44 N RAPRTSET,RAMEMARR,RA1 45 D EN2^RAUTL20(.RAMEMARR) 46 I RAPRTSET D 47 . S RA1="" 48 . F S RA1=$O(RAMEMARR(RA1)) Q:RA1=""!(RA18EX=-1) I RA1'=RACNI D 49 .. W !,?1,"Case No. : ",+RAMEMARR(RA1) 50 .. W:$P(RAMEMARR(RA1),"^",4)]"" ?18,"Exm. St: ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,12) 51 .. W ?40,"Procedure : ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,26) 52 ..;check printset for contrast media; display if CM data exists 53 ..S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RA1) 54 ..D:$L(RACMDATA) CMEDIA(RACMDATA) 55 ..K RACMDATA 56 .. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1 ;P18 57 .. Q 58 . Q 59 SS1 I RA18EX=-1 Q ;P18 60 S Y(0)=RASUBY0 61 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) 62 W !?40,"Req Phys : ",$E($S($D(^VA(200,+$P(Y(0),"^",14),0)):$P(^(0),"^"),1:""),1,25),!,RAI 63 I $D(^RARPT(+RARPT,0)),$P(^(0),"^",5)="V" W !?3,$C(7),"Report has already been verified!",! D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START 64 ;Create new rpt, or skip to IN to edit existing report 65 G IN^RARTE4:$D(^RARPT(+RARPT,0)) 66 G:'RAPRTSET NEW G:$P(^RA(72,+RAST,0),"^",3)>0 NEW 67 ; case is part of a print set, AND is cancelled 68 N RA2 S (RA1,RA2)="" 69 F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" S:$P(RAMEMARR(RA1),"^",3)]"" RA2=$P(RAMEMARR(RA1),"^",3) 70 G:RA2="" NEW 71 W !!,$C(7),"Other cases of this cancelled case ",RACN,"'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." 72 W !!,"Do you want to include this cancelled case in the same report",!,"as the others in the print set ?" 73 S %=2 D YN^DICN 74 W:%>0 "...",$S(%=1:"Include",1:"Skip")," this case" 75 I %=1 S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RA2,RARPT=RA2,RARPTN=$P(^RARPT(RARPT,0),"^"),RA1=RACN D INSERT^RARTE2 76 D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START 77 NEW G:'RAPRTSET NEW1 78 L +^RADPT(RADFN,"DT",RADTI):0 G:$T NEW1 79 W !!?10,$C(7),"** This case belongs to a printset,",?68,"**",!?10,"** and someone else is currently doing REPORT ENTRY/EDIT",?68,"**" 80 W !?10,"** on another case for this same printset,",?68,"**",!?10,"** so you may not enter a new report.",?68,"**" 81 H 2 D UNLOCK^RAUTL12(RAPNODE,RACNI) D INCRPT^RARTE4 G START 82 NEW1 S RARPTN=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN 83 W !?3,"...report not entered for this exam...",!?10,"...will now initialize report entry..." 84 S I=+$P(^RARPT(0),"^",3) 85 G LOCK^RARTE4 86 Q 87 ; 88 CMEDIA(X) ;check if contrast media is associated with the report (exam) 89 ;variables assumed to exist X: the string of contrast media used 90 ;delimited by the comma. 91 N Y W !," Contrast :" 92 F Y=1:1 Q:$P(X,", ",Y)="" W ?12,$P(X,", ",Y) W:$P(X,", ",Y+1)'="" ! 93 Q
Note:
See TracChangeset
for help on using the changeset viewer.
