- 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/RAPTLU.m
r613 r623 1 RAPTLU ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Patient's Exam Lookup ;11/13/00 09:13 2 ;;5.0;Radiology/Nuclear Medicine;**2,8,15,23,56**;Mar 16, 1998;Build 3 3 ;Supported EA #10001 DT^DIO2 4 ;Supported IA #2378 ORCHK^GMRAOR 5 ;Supported IA #10035 ^DPT( 6 ;Supported IA #10040 ^SC( 7 ;Private IA #1123 RACHK^GMRARAD, RADD^GMRARAD 8 ;*********************************************************************** 9 ; <<< NOTE >>> 10 ; 'RANOSCRN' is set in the entry actions of various options. 11 ; If the variable exists, the screen is ignored. Code is in line 12 ; label PRT+0. 13 ;*********************************************************************** 14 CASE D SEL S:'RACNT X="^" G Q:X="^"!($D(RAF1)) F I=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",I)=$P(Y,"^",I) 15 S ^DISV($S($D(DUZ)#2:DUZ,1:0),"RA","CASE #")=RADFN_"^"_RADTI_"^"_RACNI,Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 16 Q K RTESC,RTFL,RACNT,RAERR,RASTP,RAELOC,RADTPRT,^TMP("MAG",$J,"COL"),^TMP("MAG",$J,"ROW") Q 17 ; 18 SEL Q:'$D(^DPT(RADFN,0)) S RANME=^(0),RASSN=$$SSN^RAUTL,RANME=$P(RANME,"^") K ^TMP($J,"RAEX") D HOME^%ZIS D HD S X="",RACNT=0 19 ;I $$IMAGE^RARIC1 D MED^MAGSET3,ERASE^MAGSET3 ;don't call MAG 111300 20 S X="" 21 F RADTI=0:0 Q:X="^"!(X>0) S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0 I $D(^(RADTI,0)) S RANODE=^(0),RADTE=+^(0) D SEL2 ;swm080398 22 Q:X="^"!(X>0) I 'RACNT W !?3,$C(7),"No matches found!" Q 23 ;**Next line commented out - was causing selection screen to disappear 24 ; and automatically go on to detailed screen if there was only one 25 ; case for the patient 26 D ASK^RAUTL4 S:X="" X="^" 27 Q 28 SEL2 ; per RACNLU, check loc access, need split For Loop,swm080398 29 S RADIV=+$P(RANODE,"^",3),RAIMAGE=+$P(RANODE,"^",2) 30 S RADIV=+$G(^RA(79,RADIV,0)),RADIV=$P($G(^DIC(4,RADIV,0)),"^") 31 S:RADIV']"" RADIV="Unknown" 32 S RAIMAGE=$P($G(^RA(79.2,RAIMAGE,0)),"^") 33 S:RAIMAGE']"" RAIMAGE="Unknown" 34 I '$D(ORVP),($D(RANOSCRN)),('$D(RADUPSCN)) I $D(^TMP($J,"RA D-TYPE"))!($D(^TMP($J,"RA I-TYPE"))) Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMAGE))) ;this stmt taken from RACNLU 35 ; continue, since user has loc access 36 F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 I $D(^(RACNI,0)) S RACN=^(0) D PRT Q:X="^"!(X>0) 37 Q 38 PRT ; Screen only if entered through Rad/Nuc Med 39 I '$D(ORVP),'$D(RANOSCRN),'$D(RAOPT("DOSAGE TICKET")),'$D(RAOPT("UNCORRECTED REPORTS")) Q:$$IMGTY^RAUTL12("e",RADFN,RADTI)'=RAIMGTY 40 ; "Duplicate Dosage Ticket" option has its own screen 41 I $D(RAOPT("DOSAGE TICKET")) Q:$P($G(^RA(79.2,+$P(^RADPT(RADFN,"DT",RADTI,0),U,2),0)),U,5)'="Y" 42 S RARPT=+$P(RACN,"^",17) 43 Q:$D(RAOPT("UNCORRECTED REPORTS"))&('$O(^RARPT(RARPT,"ERR",0))) 44 S RAST=+$P(RACN,"^",3),RAPRC=$S($D(^RAMIS(71,+$P(RACN,"^",2),0)):$P(^(0),"^"),1:"Unknown"),RACN=+RACN S (RADTPRT,Y)=RADTE D D^RAUTL S RADATE=Y 45 S RAELOC=$P($G(^SC(+$P($G(^RA(79.1,+$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,4),0)),U),0)),U),RADTPRT=$E(RADTPRT,4,5)_"/"_$E(RADTPRT,6,7)_"/"_$E(RADTPRT,2,3) 46 S:RAELOC="" RAELOC="* MISSING *" 47 S RACNT=RACNT+1,^TMP($J,"RAEX",RACNT)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST 48 I $D(RAREPORT) D 49 . S RAIMGTYI=$$IMGTY^RAUTL12("e",RADFN,RADTI) 50 . S RASTP=$E($$GET1^DIQ(74,+RARPT,5),1,16) ;get all possible Rpt Statuss 51 . I RASTP="",RAIMGTYI'="" S RASTP=RASTP_$S($D(^RA(72,"AA",RAIMGTYI,0,+RAST)):" (Exam Dc'd)",1:"") 52 . Q 53 I '$D(RAREPORT) S RASTP=$S($D(^RA(72,RAST,0)):$P(^(0),"^"),1:"Unknown") 54 ; D:$$IMAGE^RARIC1 DISPA^MAGRIC ;don't call MAG 111300 55 N RAPRTSET,RAMEMLOW D EN1^RAUTL20 56 W !,RACNT,?5,$S(RAMEMLOW:"+",RAPRTSET:".",1:" "),?6,RACN,?11,$$IMGDISP(RARPT),?13,$E(RAPRC,1,26),?41,RADTPRT,?52,$E(RASTP,1,16),?69,$E(RAELOC,1,11) 57 I (($Y+6)>IOSL),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI))!($O(^RADPT(RADFN,"DT",RADTI)))) D ASK^RAUTL4 W @IOF 58 Q 59 ; 60 HD I '$D(RTFL) W @IOF,?25,RAHEAD,!!,"Patient's Name: ",$E(RANME,1,20)," ",RASSN,?55,"Run Date: " S Y=DT D DT^DIO2 61 I $D(RTFL) D ESC^RTRD:($Y+6)>IOSL Q:$D(RTESC) W !!,"============================ Exam Procedure Profile ==========================" 62 W !!?3,"Case No.",?13,"Procedure",?41,"Exam Date",?52,"Status of " W $S($D(RAREPORT):"Report",1:"Exam"),?69,"Imaging Loc" 63 W !?3,"--------",?13,"-------------",?41,"---------",?52,"----------------",?69,"-----------" Q 64 ; 65 PTUPD ;Update Patient Info 66 S DIC(0)="AEMQL" D ^RADPA K DIC,RAIC Q:Y<0 S DIE="^RADPT(",DA=+Y,DR=".04;1" D ^DIE 67 PTUPD0 K DIR S DIR(0)="SOMA^Y:YES;N:NO;",DIR("A")="CONTRAST MEDIUM ALLERGY: " 68 S ALLERGY=$$ORCHK^GMRAOR(DA,"CM") 69 I ALLERGY]"" S DIR("B")=$S(ALLERGY=1:"YES",1:"NO") 70 S DIR("?")="^D PTUPDH1^RAPTLU",DIR("??")="^D PTUPDH2^RAPTLU" 71 D ^DIR K DIR I $D(DIRUT) G PTUPDX 72 I ALLERGY'=$TR(Y,"YN","10") S X=0 D G:'X PTUPDX W " ??",$C(7) G PTUPD0 73 . I Y="N" S X=$$RACHK^GMRARAD(DA,Y) 74 . I Y="Y" S X=($$RADD^GMRARAD(DA,"p",Y)'>0) 75 . Q 76 PTUPDX K %,%Y,ALLERGY,C,D,D0,DA,DE,DQ,DIE,DIR,DR,RAPTFL,DIC,X,Y 77 Q 78 PTUPDH1 W !?5,"If this patient has had an allergic reaction to contrast medium, enter 'Y'" 79 W !?5,"for YES at this prompt. If not, enter 'N' for NO." 80 D PTUPDH3 81 Q 82 PTUPDH2 ; 83 W !?5,"The value in this field is used to indicate if this Radiology" 84 W !?5,"/Nuclear Medicine patient has had an allergic reaction to the contrast" 85 W !?5,"medium during a Radiology/Nuclear Medicine procedure. It may contain a" 86 W !?5,"'Y' for YES, or 'N' for NO. If YES, then a warning message is" 87 W !?5,"displayed to the receptionist whenever this patient is" 88 W !?5,"registered for a procedure that may involve contrast material." 89 D PTUPDH3 90 Q 91 PTUPDH3 W !?5,"CHOOSE FROM:" 92 W !?5," Y YES" 93 W !?5," N NO" 94 Q 95 IMGDISP(RARPT) ; Display "i" if an image is associated with the Rad/Nuc Med 96 ; Report. Called from RAPROS - Exam Profile (Selected Sort) 97 ; Input : RARPT - ien of the report 98 ; Output: "i" if an image exists, else null ("") 99 Q $S(+$O(^RARPT(RARPT,2005,0)):"i",1:"") 1 RAPTLU ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Patient's Exam Lookup ;11/13/00 09:13 2 ;;5.0;Radiology/Nuclear Medicine;**2,8,15,23**;Mar 16, 1998 3 ;*********************************************************************** 4 ; <<< NOTE >>> 5 ; 'RANOSCRN' is set in the entry actions of various options. 6 ; If the variable exists, the screen is ignored. Code is in line 7 ; label PRT+0. 8 ;*********************************************************************** 9 CASE D SEL S:'RACNT X="^" G Q:X="^"!($D(RAF1)) F I=1:1:11 S @$P("RADFN^RADTI^RACNI^RANME^RASSN^RADATE^RADTE^RACN^RAPRC^RARPT^RAST","^",I)=$P(Y,"^",I) 10 S ^DISV($S($D(DUZ)#2:DUZ,1:0),"RA","CASE #")=RADFN_"^"_RADTI_"^"_RACNI,Y(0)=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) 11 Q K RTESC,RTFL,RACNT,RAERR,RASTP,RAELOC,RADTPRT,^TMP("MAG",$J,"COL"),^TMP("MAG",$J,"ROW") Q 12 ; 13 SEL Q:'$D(^DPT(RADFN,0)) S RANME=^(0),RASSN=$$SSN^RAUTL,RANME=$P(RANME,"^") K ^TMP($J,"RAEX") D HOME^%ZIS D HD S X="",RACNT=0 14 ;I $$IMAGE^RARIC1 D MED^MAGSET3,ERASE^MAGSET3 ;don't call MAG 111300 15 S X="" 16 F RADTI=0:0 Q:X="^"!(X>0) S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0 I $D(^(RADTI,0)) S RANODE=^(0),RADTE=+^(0) D SEL2 ;swm080398 17 Q:X="^"!(X>0) I 'RACNT W !?3,*7,"No matches found!" Q 18 ;**Next line commented out - was causing selection screen to disappear 19 ; and automatically go on to detailed screen if there was only one 20 ; case for the patient 21 D ASK^RAUTL4 S:X="" X="^" 22 Q 23 SEL2 ; per RACNLU, check loc access, need split For Loop,swm080398 24 S RADIV=+$P(RANODE,"^",3),RAIMAGE=+$P(RANODE,"^",2) 25 S RADIV=+$G(^RA(79,RADIV,0)),RADIV=$P($G(^DIC(4,RADIV,0)),"^") 26 S:RADIV']"" RADIV="Unknown" 27 S RAIMAGE=$P($G(^RA(79.2,RAIMAGE,0)),"^") 28 S:RAIMAGE']"" RAIMAGE="Unknown" 29 I '$D(ORVP),($D(RANOSCRN)),('$D(RADUPSCN)) I $D(^TMP($J,"RA D-TYPE"))!($D(^TMP($J,"RA I-TYPE"))) Q:'$D(^TMP($J,"RA D-TYPE",RADIV))!('$D(^TMP($J,"RA I-TYPE",RAIMAGE))) ;this stmt taken from RACNLU 30 ; continue, since user has loc access 31 F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 I $D(^(RACNI,0)) S RACN=^(0) D PRT Q:X="^"!(X>0) 32 Q 33 PRT ; Screen only if entered through Rad/Nuc Med 34 I '$D(ORVP),'$D(RANOSCRN),'$D(RAOPT("DOSAGE TICKET")),'$D(RAOPT("UNCORRECTED REPORTS")) Q:$$IMGTY^RAUTL12("e",RADFN,RADTI)'=RAIMGTY 35 ; "Duplicate Dosage Ticket" option has its own screen 36 I $D(RAOPT("DOSAGE TICKET")) Q:$P($G(^RA(79.2,+$P(^RADPT(RADFN,"DT",RADTI,0),U,2),0)),U,5)'="Y" 37 S RARPT=+$P(RACN,"^",17) 38 Q:$D(RAOPT("UNCORRECTED REPORTS"))&('$O(^RARPT(RARPT,"ERR",0))) 39 S RAST=+$P(RACN,"^",3),RAPRC=$S($D(^RAMIS(71,+$P(RACN,"^",2),0)):$P(^(0),"^"),1:"Unknown"),RACN=+RACN S (RADTPRT,Y)=RADTE D D^RAUTL S RADATE=Y 40 S RAELOC=$P($G(^SC(+$P($G(^RA(79.1,+$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,4),0)),U),0)),U),RADTPRT=$E(RADTPRT,4,5)_"/"_$E(RADTPRT,6,7)_"/"_$E(RADTPRT,2,3) 41 S:RAELOC="" RAELOC="* MISSING *" 42 S RACNT=RACNT+1,^TMP($J,"RAEX",RACNT)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST 43 I $D(RAREPORT) D 44 . S RASTP=$S($D(^RARPT(RARPT,0)):$P(^(0),"^",5),1:"") 45 . S RAIMGTYI=$$IMGTY^RAUTL12("e",RADFN,RADTI) 46 . S RASTP=$S(RASTP="V":"VERIFIED",RASTP="PD":"PROBLEM DRAFT",RASTP="D":"DRAFT",RASTP="R":"RELEASED/NOT VERIFIED",1:"None") 47 . I RASTP="None",RAIMGTYI'="" S RASTP=RASTP_$S($D(^RA(72,"AA",RAIMGTYI,0,+RAST)):" (Exam Dc'd)",1:"") 48 . Q 49 I '$D(RAREPORT) S RASTP=$S($D(^RA(72,RAST,0)):$P(^(0),"^"),1:"Unknown") 50 ; D:$$IMAGE^RARIC1 DISPA^MAGRIC ;don't call MAG 111300 51 N RAPRTSET,RAMEMLOW D EN1^RAUTL20 52 W !,RACNT,?5,$S(RAMEMLOW:"+",RAPRTSET:".",1:" "),?6,RACN,?11,$$IMGDISP(RARPT),?13,$E(RAPRC,1,26),?41,RADTPRT,?52,$E(RASTP,1,16),?69,$E(RAELOC,1,11) 53 I (($Y+6)>IOSL),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI))!($O(^RADPT(RADFN,"DT",RADTI)))) D ASK^RAUTL4 W @IOF 54 Q 55 ; 56 HD I '$D(RTFL) W @IOF,?25,RAHEAD,!!,"Patient's Name: ",$E(RANME,1,20)," ",RASSN,?55,"Run Date: " S Y=DT D DT^DIO2 57 I $D(RTFL) D ESC^RTRD:($Y+6)>IOSL Q:$D(RTESC) W !!,"============================ Exam Procedure Profile ==========================" 58 W !!?3,"Case No.",?13,"Procedure",?41,"Exam Date",?52,"Status of " W $S($D(RAREPORT):"Report",1:"Exam"),?69,"Imaging Loc" 59 W !?3,"--------",?13,"-------------",?41,"---------",?52,"----------------",?69,"-----------" Q 60 ; 61 PTUPD ;Update Patient Info 62 S DIC(0)="AEMQL" D ^RADPA K DIC,RAIC Q:Y<0 S DIE="^RADPT(",DA=+Y,DR=".04;1" D ^DIE 63 PTUPD0 K DIR S DIR(0)="SOMA^Y:YES;N:NO;",DIR("A")="CONTRAST MEDIUM ALLERGY: " 64 S ALLERGY=$$ORCHK^GMRAOR(DA,"CM") 65 I ALLERGY]"" S DIR("B")=$S(ALLERGY=1:"YES",1:"NO") 66 S DIR("?")="^D PTUPDH1^RAPTLU",DIR("??")="^D PTUPDH2^RAPTLU" 67 D ^DIR K DIR I $D(DIRUT) G PTUPDX 68 I ALLERGY'=$TR(Y,"YN","10") S X=0 D G:'X PTUPDX W " ??",$C(7) G PTUPD0 69 . I Y="N" S X=$$RACHK^GMRARAD(DA,Y) 70 . I Y="Y" S X=($$RADD^GMRARAD(DA,"p",Y)'>0) 71 . Q 72 PTUPDX K %,%Y,ALLERGY,C,D,D0,DA,DE,DQ,DIE,DIR,DR,RAPTFL,DIC,X,Y 73 Q 74 PTUPDH1 W !?5,"If this patient has had an allergic reaction to contrast medium, enter 'Y'" 75 W !?5,"for YES at this prompt. If not, enter 'N' for NO." 76 D PTUPDH3 77 Q 78 PTUPDH2 ; 79 W !?5,"The value in this field is used to indicate if this Radiology" 80 W !?5,"/Nuclear Medicine patient has had an allergic reaction to the contrast" 81 W !?5,"medium during a Radiology/Nuclear Medicine procedure. It may contain a" 82 W !?5,"'Y' for YES, or 'N' for NO. If YES, then a warning message is" 83 W !?5,"displayed to the receptionist whenever this patient is" 84 W !?5,"registered for a procedure that may involve contrast material." 85 D PTUPDH3 86 Q 87 PTUPDH3 W !?5,"CHOOSE FROM:" 88 W !?5," Y YES" 89 W !?5," N NO" 90 Q 91 IMGDISP(RARPT) ; Display "i" if an image is associated with the Rad/Nuc Med 92 ; Report. Called from RAPROS - Exam Profile (Selected Sort) 93 ; Input : RARPT - ien of the report 94 ; Output: "i" if an image exists, else null ("") 95 Q $S(+$O(^RARPT(RARPT,2005,0)):"i",1:"")
Note:
See TracChangeset
for help on using the changeset viewer.
