source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RADEM1.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1RADEM1 ;HISC/GJC-Display Patient Demographics ;4/19/96 08:17
2 ;;5.0;Radiology/Nuclear Medicine;**45**;Mar 16, 1998
3EXAM D HDR S RAXIT=0
4 S X1=DT,X2=-7 D C^%DTC S RACHKDT=X,X1=DT,X2=-3 D C^%DTC S RACHKDT1=X
5 S (RADTE,RASEQ)=0 F RADTI=0:0 Q:(RASEQ>4)&(RADTE<RACHKDT)!RAXIT S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:RADTI'>0!RAXIT I $D(^(RADTI,0)) S Y=^(0),RALOC=+$P(Y,"^",4),(RADTE,Y)=+Y Q:(RASEQ>4)&(RADTE<RACHKDT) D D^RAUTL S RADATE=Y D RACN
6 I $G(RAXIT) G Q
7 D ORDER ;Check for outstanding orders
8 W:'RASEQ !!?5,"No registered exams filed for this patient.",!
9 W:$D(RABARFL) !?2," *Exam with Barium performed in last 7 days."
10 W:$D(RAORFL) !?2," **Oral Cholecystographic medium used in last 7 days."
11 I $D(RACNFL) D
12 .N DIWF,DIWL,DIWR,DIWT,X K ^UTILITY($J,"W")
13 .S:'$D(RAZDFN)#2 X="***Exam with contrast media performed in last 3 days."
14 .S:$D(RAZDFN)#2 X="***Exam with "_$$CM(RAZDFN,RAZDTI,RAZCNI)_" performed in last 3 days."
15 .S DIWL=3,DIWF="C60" D ^DIWP,^DIWW ;UTILITY($J,"W") killed in DIWW
16 .Q
17 I '$D(RACONT),('+$G(RAXIT)) R !!,"Press <RETURN> key to continue.",X:DTIME
18Q K %,%H,DIC,POP,RACNFL,RAORFL,RACODE,RACONT,RABAR,RABARFL,RACHKDT,RACHKDT1,RACN,RACNI,RADATE,RADTE,RADTI,RAPR1,RAPRI,RASEQ,RAST,RASTI,RAXIT,RAZDFN,RAZDTI,RAZCNI Q
19 ;
20RACN S RALOC=$S($D(^RA(79.1,RALOC,0)):$P(^(0),"^"),1:"") S RALOC=$S($D(^SC(+RALOC,0)):$P(^(0),"^"),1:"Unknown")
21 F RACNI=0:0 Q:(RASEQ>4)&(RADTE<RACHKDT)!RAXIT S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!RAXIT I $D(^(RACNI,0)) S Y=^(0) D PRT
22 Q
23 ;
24PRT N RAESITY,RAITYPE
25 S RAPRI=+$P(Y,"^",2),RAPR1=99 S:$D(^RAMIS(71,RAPRI,0)) RAPR1=$P(^(0),"^") S RABAR=0
26 I $P(Y,U,10)="Y" D
27 .I RADTE'<RACHKDT,($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM","B",""))="B") S (RABAR,RABARFL)=1,RACODE=" *"
28 .I RADTE'<RACHKDT,(+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM","B","C",0))>0) S (RABAR,RAORFL)=1,RACODE=" **"
29 .I RADTE'<RACHKDT1 D
30 ..S (RABAR,RACNFL)=1,RACODE="***"
31 ..I +$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0)) S RAZDFN=RADFN,RAZDTI=RADTI,RAZCNI=RACNI
32 ..Q
33 .Q
34 S RASTI=+$P(Y,"^",3)
35 S RAST=$S($D(^RA(72,RASTI,0)):$P(^(0),"^"),1:"Unknown")
36 S RAESITY=+$P($G(^RA(72,RASTI,0)),U,7)
37 S RAITYPE=$P($G(^RA(79.2,RAESITY,0)),U)
38 S RAITYPE=$S(RAITYPE]"":RAITYPE,1:"Unknown")
39 S RACN=$S($D(^RA(72,"AA",RAITYPE,9,RASTI)):"",1:+Y)
40 ; flag if print set and if lowest case of set
41 N RAPRTSET,RAMEMLOW,RADISP D EN1^RAUTL20
42 S RADISP=$S(RAMEMLOW&(RAPRTSET):"+",RAPRTSET:".",1:" ")
43 S RASEQ=RASEQ+1 W:RASEQ<6!(RABAR) !,RACN,?6,RADISP,?7,$S(RABAR:RACODE,1:""),?10,$E(RAPR1,1,28),?39,$E(RADATE,1,11),?51,$E(RAST,1,12),?67,$E(RALOC,1,12)
44 I $E(IOST,1,2)="C-",($Y>(IOSL-4)) D
45 . N DIR S DIR(0)="E" D ^DIR S RAXIT=$S(Y'>0:1,1:0)
46 . I 'RAXIT W @IOF D HDR
47 . Q
48 Q
49ORDER ; Check for pat rad orders before registering a patient in rad
50 ; Created by GJC@1/3/94
51 N RALP,RA751,DIROUT,DIRUT,DTOUT,DUOUT S (RALP,RAXIT)=0
52 F S RALP=$O(^RAO(75.1,"B",RADFN,RALP)) Q:RALP'>0!(RAXIT) D
53 . Q:$D(^RADPT("AO",RALP,RADFN))\10 ;Check for entry in file 70.
54 . Q:+$P($G(^RAO(75.1,RALP,0)),U,5)<3
55 . S RA751(0)=$G(^RAO(75.1,RALP,0)),RA751(2)=$P(RA751(0),U,2)
56 . S RA751(16)=$P(RA751(0),U,16),RA751(20)=$P(RA751(0),U,20)
57 . S RA751(5)=+$P(RA751(0),U,5) Q:RA751(5)=1 ;GJC@4/4/94 Cancelled xam
58 . S Y=RA751(2),C=$P($G(^DD(75.1,2,0)),U,2) D:Y]"" Y^DIQ S RA751(2)=Y
59 . S Y=RA751(20),C=$P($G(^DD(75.1,20,0)),U,2) D:Y]"" Y^DIQ S RA751(20)=Y
60 . W !?10,$E(RA751(2),1,28),?51,"Ord "
61 . W $S(RA751(16)]"":$$FMTE^XLFDT(RA751(16),"2D"),1:"")
62 . W ?67,$E(RA751(20),1,12) ; prints 'SUBMIT REQUEST TO' data
63 . I $E(IOST,1,2)="C-",($Y>(IOSL-4)) D
64 .. K DIR S DIR(0)="E" D ^DIR K DIR S:'+Y RAXIT=1
65 .. I 'RAXIT W @IOF D HDR
66 .. Q
67 . Q
68 Q
69HDR ; Header
70 ; Created by GJC@1/3/94
71 ; The variable: RAOPT("ORDEREXAM") is defined in the entry action of
72 ; the option RA ORDEREXAM. It is subsequently kill in the exit action
73 ; of the option.
74 D HOME^%ZIS W:$D(RAOPT("ORDEREXAM"))#2 @IOF
75 W !!,"Case #",?10,"Last 5 Procedures/New Orders",?39,"Exam Date",?51,"Status of Exam",?67,"Imaging Loc."
76 W !,"------",?10,"----------------------------",?39,"---------",?51,"--------------",?67,"------------"
77 Q
78 ;
79CM(RADFN,RADTI,RACNI) ;Return the contrast media used while performing an
80 ;exam.
81 ;Input: RADFN=patient DFN
82 ; RADTI=inverse date/time of exam
83 ; RACNI=IEN of an individual case
84 ;Return: contrast media used with exam delimited by ', '.
85 N I,X S X="",I=0
86 F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I)) Q:'I D
87 .S I(0)=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",I,0),U)
88 .S X=X_$$EXTERNAL^DILFD(70.3225,.01,"",I(0))_", "
89 .Q
90 I $L(X,", ")'>2 S X=$P(X,", ")
91 E S X=$P(X,", ",1,($L(X,", ")-1))
92 Q X
93 ;
Note: See TracBrowser for help on using the repository browser.