source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPROD1.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1RAPROD1 ;HISC/FPT,GJC AISC/MJK,RMO-Detailed Exam View ;11/26/96 08:24
2 ;;5.0;Radiology/Nuclear Medicine;**15,18,45,77**;Mar 16, 1998;Build 7
3 ;last mof by SS for P18 JUN 29 ,00
4 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - correct paging issue
5PER ; Display personnel information.
6 K DIR,DIROUT,DIRUT,DTOUT,DUOUT N Y
7 S DIR(0)="Y",DIR("B")="No"
8 S DIR("A")="Do you wish to display all personnel involved"
9 D ^DIR S:$D(DIRUT) X="^"
10 K DIR,DIROUT,DIRUT,DTOUT,DUOUT I X="^" D Q QUIT
11 G:+Y=0 ACT ; (Y=1:Yes,Y=0:No)
12 S RAXIT=0 D PERHDR
13 S RAXIT=$$PERINFO(RADFN,RADTI,RACNI)
14 I RAXIT D Q QUIT
15 I $D(RACM) D CMHIST^RAPROD2(RADFN,RADTI,RACNI)
16 I RAXIT D Q QUIT
17ACT R !!,"Do you wish to display activity log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G STAT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if activity log should be displayed, or 'NO' if not." G ACT
18 W !!?23,"*** Exam Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?3,"Technologist comment",!?2,"---------------------",?25,"------",?60,"-------------"
19 N RA18RET S RADD=70.07 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",I)) Q:I'>0 I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 S RA18RET=$$PUTTCOM3^RAUTL11(RADFN,RADTI,RACNI,I,"",3,78,7,0,1,6,0) S:RA18RET=-1 RAXIT=1 Q:RA18RET=-1 ;P18
20 I $D(RAXIT) I RAXIT D Q QUIT ;P18
21 ;
22 G STAT:'RARPT W !!?22,"*** Report Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?2,"---------",?25,"------",?60,"-------------"
23 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - added screen length check to next line
24 S RADD=74.01 F I=0:0 S I=$O(^RARPT(RARPT,"L",I)) Q:I'>0 I $D(^(I,0)) S RAY=^(0),Y=+RAY D ACT1 I $$CONTIN^RAUTL11(7)=-1 S RAXIT=1 Q
25 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 Added next line
26 I $G(RAXIT) D Q QUIT
27 W ! S X="",$P(X,"=",80)="" W X K X
28 G STAT
29ACT1 D D^RAUTL W !?2,Y,?25,$E($P($P(^DD(RADD,2,0),$P(RAY,"^",2)_":",2),";"),1,33),?60,$E($S($D(^VA(200,+$P(RAY,"^",3),0)):$P(^(0),"^"),1:"Unknown"),1,18) Q
30 ;
31STAT G TEXT:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T"))
32ASKSTA R !!,"Do you wish to display exam status tracking log? No// ",X:DTIME S X=$E(X) S:'$T X="^" G Q:X="^" S:X="" X="N" G TEXT:"Nn"[X I "Yy"'[X W:X'="?" $C(7) D G ASKSTA
33 . W !!?3,"Enter 'YES' if exam status tracking log should be displayed, or 'NO' if not."
34 . Q
35 S RAXIT=0 D STATHDR ; print header
36 K RAX2 S RACUM=""
37 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",I)) Q:I'>0 I $D(^(I,0)) S RA=^(0),RAX1=+RA D STAT1 Q:$D(RAX2)&('$D(RAMTIME)) Q:RAXIT S RAX2=RAX1
38 Q:RAXIT W ! S X="",$P(X,"=",80)="" W X K X
39TEXT S X=$E(RA("RST")) G Q:X="P"!(X="N")!(X="D")
40ASKTXT R !!,"Do you wish to display exam report text? No// ",X:DTIME S X=$E(X) S:'$T!(X="")!(X="^") X="N" G Q:"Nn"[X I "Yy"'[X W:X'="?" $C(7) W !!?3,"Enter 'YES' if report text should be displayed, or 'NO' if not." G ASKTXT
41 D DISP^RART1
42Q ; kill and quit
43 K I,J,POP,RAMTIME,RAPRC,RAPRT,RADFN,RADTI,RACNI,RARPT,RANME,RASSN,RADATE,RADTE,RAST,RACN,RA,RAY,RACI,RADD,RADI,RAMOD,RAX,RAX1,RAX2,RAELAP,RACUM,Z
44 K RAXIT,RACM
45 Q
46STAT1 ; display status tracking info
47 K RAELAP I $D(RAX2) S X1=RAX1,X=RAX2 D ELAPSED^RAUTL1 Q:'$D(RAMTIME) S RAELAP=Y D CUMUL
48 S Y=RAX1 D D^RAUTL
49 W:$D(RAELAP) ?49,RAELAP,?65,RACUM
50 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D STATHDR
51 W !?2,$S($D(^RA(72,+$P(RA,"^",2),0)):$E($P(^(0),"^"),1,20),1:"Unknown"),?25,Y
52 Q
53CUMUL ; calculate time frame
54 Q:$E(Y)="N" F RAI=1:1:3 S RA(RAI)=+$P(RACUM,":",RAI)+$P(Y,":",RAI)
55 F RAI=3:-1:2 S:RA(RAI)>59 RA(RAI-1)=RA(RAI-1)+1,RA(RAI)=RA(RAI)-60
56 S RACUM=$E(RA(1)+100,2,3)_":"_$E(RA(2)+100,2,3)_":"_$E(RA(3)+100,2,3) K RAI,RA(1),RA(2),RA(3)
57 Q
58STATHDR ; Print status tracking header
59 D:'$D(IOF) HOME^%ZIS W @IOF
60 W !!,?23,"*** Exam Status Tracking Log ***",!,?47,"Elapsed Time",?61,"Cumulative Time",!,?2,"Status",?25,"Date/Time",?48,"(DD:HH:MM)",?64,"(DD:HH:MM)",!,?2,"------",?25,"---------",?47,"------------",?61,"---------------"
61 Q
62PERHDR ; Print personnel header
63 D:'$D(IOF) HOME^%ZIS W @IOF
64 N X,Y S X="*** Imaging Personnel ***"
65 S $P(Y,"-",(IOM+1))="" W !?(IOM-$L(X)\2),X,!,Y
66 Q
67PERINFO(RADFN,RADTI,RACNI) ; Personnel information
68 ; Pass back 0 if ok, 1 if interrupt
69 Q:'$L(RADFN)!('$L(RADTI))!('$L(RACNI)) 1
70 N RA70,RAHD1,RAHD2,RAHD3,RAPIR,RAPIS,RAPRE,RARP,RARPT,RASIR,RASIS
71 N RATECH,RATRAN,RAVER
72 S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
73 S RARPT=+$P(RA70,"^",17) S:'RARPT RATRAN="No Report"
74 S:'RARPT (RAPRE,RAVER,RAPRE("DT"),RAVER("DT"))=""
75 I RARPT D
76 . S RARPT(0)=$G(^RARPT(RARPT,0))
77 . S RARPT("T")=$G(^RARPT(RARPT,"T"))
78 . S RATRAN=$S($D(^VA(200,+RARPT("T"),0)):$P(^(0),"^"),1:"")
79 . S RAPRE=$S($D(^VA(200,+$P(RARPT(0),"^",13),0)):$P(^(0),"^"),1:"")
80 . S RAVER=$S($D(^VA(200,+$P(RARPT(0),"^",9),0)):$P(^(0),"^"),1:"")
81 . S RAPRE("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",12),"2F")," /","0")
82 . S RAVER("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",7),"2F")," /","0")
83 . Q
84 S RAPIR=$S($D(^VA(200,+$P(RA70,"^",12),0)):$P(^(0),"^"),1:"")
85 S RAPIS=$S($D(^VA(200,+$P(RA70,"^",15),0)):$P(^(0),"^"),1:"")
86 S RASIR=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
87 S RASIS=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
88 S RATECH=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
89 W !,"Primary Int'g Resident: ",RAPIR
90 W !,"Primary Int'g Staff : ",RAPIS
91 W !,"Pre-Verifier: ",RAPRE," ",RAPRE("DT")
92 W !,"Verifier : ",RAVER," ",RAVER("DT"),!
93 S RAHD1="W !,""Secondary Interpreting Resident"",?40,""Secondary Interpreting Staff"""
94 S RAHD2="W !,""-------------------------------"",?40,""----------------------------"""
95 X RAHD1,RAHD2
96 I 'RASIR,('RASIS) W !,"None",?40,"None"
97 E D Q:RAXIT 1
98 . S (RASIR,RASIS)=.001
99 . F D Q:(('RASIR)&('RASIS))!(RAXIT)
100 .. I $Y>(IOSL-4) D Q:RAXIT
101 ... S RAXIT=$$EOS^RAUTL5()
102 ... I 'RAXIT D PERHDR X RAHD1,RAHD2
103 ... Q
104 .. W ! D SECRES:RASIR,SECSTF:RASIS
105 .. Q
106 . Q
107 I $Y>(IOSL-4) D Q:RAXIT 1
108 . S RAXIT=$$EOS^RAUTL5()
109 . D:'RAXIT PERHDR
110 . Q
111 W ! S RAHD3="W !,""Technologist(s) Transcriptionist"",!,""--------------- ----------------""" X RAHD3
112 I 'RATECH W !,"None",?40,RATRAN
113 E D Q:RAXIT 1
114 . N RA S RA=0
115 . F S RA=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA)) Q:RA'>0 D Q:RAXIT
116 .. S RATECH(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA,0))
117 .. S RATECH=$S($D(^VA(200,+RATECH(0),0)):$P(^(0),"^"),1:"")
118 .. I $Y>(IOSL-4) D Q:RAXIT
119 ... S RAXIT=$$EOS^RAUTL5()
120 ... I 'RAXIT D PERHDR X RAHD3
121 ... Q
122 .. W !,RATECH W:RATRAN'=99 ?40,RATRAN S RATRAN=99
123 .. Q
124 . Q
125 Q 0
126SECRES ; Secondary Resident data
127 S:RASIR=.001 RATXT="None"
128 S RASIR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR))
129 I $D(RATXT),('+RASIR) W RATXT
130 E D
131 . S RASIR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR,0))
132 . W $S($D(^VA(200,+RASIR(0),0)):$P(^(0),"^"),1:"")
133 . Q
134 K RATXT
135 Q
136SECSTF ; Secondary Staff data
137 S:RASIS=.001 RATXT="None"
138 S RASIS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS))
139 I $D(RATXT),('+RASIS) W ?40,RATXT
140 E D
141 . S RASIS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS,0))
142 . W ?40,$S($D(^VA(200,+RASIS(0),0)):$P(^(0),"^"),1:"")
143 . Q
144 K RATXT
145 Q
Note: See TracBrowser for help on using the repository browser.