RAPROD1 ;HISC/FPT,GJC AISC/MJK,RMO-Detailed Exam View ;11/26/96 08:24
;;5.0;Radiology/Nuclear Medicine;**15,18,45,77**;Mar 16, 1998;Build 7
;last mof by SS for P18 JUN 29 ,00
;10/25/2006 BAY/KAM Remedy Call 161846, *77 - correct paging issue
PER ; Display personnel information.
K DIR,DIROUT,DIRUT,DTOUT,DUOUT N Y
S DIR(0)="Y",DIR("B")="No"
S DIR("A")="Do you wish to display all personnel involved"
D ^DIR S:$D(DIRUT) X="^"
K DIR,DIROUT,DIRUT,DTOUT,DUOUT I X="^" D Q QUIT
G:+Y=0 ACT ; (Y=1:Yes,Y=0:No)
S RAXIT=0 D PERHDR
S RAXIT=$$PERINFO(RADFN,RADTI,RACNI)
I RAXIT D Q QUIT
I $D(RACM) D CMHIST^RAPROD2(RADFN,RADTI,RACNI)
I RAXIT D Q QUIT
ACT 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
W !!?23,"*** Exam Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?3,"Technologist comment",!?2,"---------------------",?25,"------",?60,"-------------"
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
I $D(RAXIT) I RAXIT D Q QUIT ;P18
;
G STAT:'RARPT W !!?22,"*** Report Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?2,"---------",?25,"------",?60,"-------------"
;10/25/2006 BAY/KAM Remedy Call 161846, *77 - added screen length check to next line
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
;10/25/2006 BAY/KAM Remedy Call 161846, *77 Added next line
I $G(RAXIT) D Q QUIT
W ! S X="",$P(X,"=",80)="" W X K X
G STAT
ACT1 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
;
STAT G TEXT:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T"))
ASKSTA 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
. W !!?3,"Enter 'YES' if exam status tracking log should be displayed, or 'NO' if not."
. Q
S RAXIT=0 D STATHDR ; print header
K RAX2 S RACUM=""
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
Q:RAXIT W ! S X="",$P(X,"=",80)="" W X K X
TEXT S X=$E(RA("RST")) G Q:X="P"!(X="N")!(X="D")
ASKTXT 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
D DISP^RART1
Q ; kill and quit
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
K RAXIT,RACM
Q
STAT1 ; display status tracking info
K RAELAP I $D(RAX2) S X1=RAX1,X=RAX2 D ELAPSED^RAUTL1 Q:'$D(RAMTIME) S RAELAP=Y D CUMUL
S Y=RAX1 D D^RAUTL
W:$D(RAELAP) ?49,RAELAP,?65,RACUM
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D STATHDR
W !?2,$S($D(^RA(72,+$P(RA,"^",2),0)):$E($P(^(0),"^"),1,20),1:"Unknown"),?25,Y
Q
CUMUL ; calculate time frame
Q:$E(Y)="N" F RAI=1:1:3 S RA(RAI)=+$P(RACUM,":",RAI)+$P(Y,":",RAI)
F RAI=3:-1:2 S:RA(RAI)>59 RA(RAI-1)=RA(RAI-1)+1,RA(RAI)=RA(RAI)-60
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)
Q
STATHDR ; Print status tracking header
D:'$D(IOF) HOME^%ZIS W @IOF
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,"---------------"
Q
PERHDR ; Print personnel header
D:'$D(IOF) HOME^%ZIS W @IOF
N X,Y S X="*** Imaging Personnel ***"
S $P(Y,"-",(IOM+1))="" W !?(IOM-$L(X)\2),X,!,Y
Q
PERINFO(RADFN,RADTI,RACNI) ; Personnel information
; Pass back 0 if ok, 1 if interrupt
Q:'$L(RADFN)!('$L(RADTI))!('$L(RACNI)) 1
N RA70,RAHD1,RAHD2,RAHD3,RAPIR,RAPIS,RAPRE,RARP,RARPT,RASIR,RASIS
N RATECH,RATRAN,RAVER
S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
S RARPT=+$P(RA70,"^",17) S:'RARPT RATRAN="No Report"
S:'RARPT (RAPRE,RAVER,RAPRE("DT"),RAVER("DT"))=""
I RARPT D
. S RARPT(0)=$G(^RARPT(RARPT,0))
. S RARPT("T")=$G(^RARPT(RARPT,"T"))
. S RATRAN=$S($D(^VA(200,+RARPT("T"),0)):$P(^(0),"^"),1:"")
. S RAPRE=$S($D(^VA(200,+$P(RARPT(0),"^",13),0)):$P(^(0),"^"),1:"")
. S RAVER=$S($D(^VA(200,+$P(RARPT(0),"^",9),0)):$P(^(0),"^"),1:"")
. S RAPRE("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",12),"2F")," /","0")
. S RAVER("DT")=$TR($$FMTE^XLFDT($P(RARPT(0),"^",7),"2F")," /","0")
. Q
S RAPIR=$S($D(^VA(200,+$P(RA70,"^",12),0)):$P(^(0),"^"),1:"")
S RAPIS=$S($D(^VA(200,+$P(RA70,"^",15),0)):$P(^(0),"^"),1:"")
S RASIR=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
S RASIS=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
S RATECH=+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
W !,"Primary Int'g Resident: ",RAPIR
W !,"Primary Int'g Staff : ",RAPIS
W !,"Pre-Verifier: ",RAPRE," ",RAPRE("DT")
W !,"Verifier : ",RAVER," ",RAVER("DT"),!
S RAHD1="W !,""Secondary Interpreting Resident"",?40,""Secondary Interpreting Staff"""
S RAHD2="W !,""-------------------------------"",?40,""----------------------------"""
X RAHD1,RAHD2
I 'RASIR,('RASIS) W !,"None",?40,"None"
E D Q:RAXIT 1
. S (RASIR,RASIS)=.001
. F D Q:(('RASIR)&('RASIS))!(RAXIT)
.. I $Y>(IOSL-4) D Q:RAXIT
... S RAXIT=$$EOS^RAUTL5()
... I 'RAXIT D PERHDR X RAHD1,RAHD2
... Q
.. W ! D SECRES:RASIR,SECSTF:RASIS
.. Q
. Q
I $Y>(IOSL-4) D Q:RAXIT 1
. S RAXIT=$$EOS^RAUTL5()
. D:'RAXIT PERHDR
. Q
W ! S RAHD3="W !,""Technologist(s) Transcriptionist"",!,""--------------- ----------------""" X RAHD3
I 'RATECH W !,"None",?40,RATRAN
E D Q:RAXIT 1
. N RA S RA=0
. F S RA=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA)) Q:RA'>0 D Q:RAXIT
.. S RATECH(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA,0))
.. S RATECH=$S($D(^VA(200,+RATECH(0),0)):$P(^(0),"^"),1:"")
.. I $Y>(IOSL-4) D Q:RAXIT
... S RAXIT=$$EOS^RAUTL5()
... I 'RAXIT D PERHDR X RAHD3
... Q
.. W !,RATECH W:RATRAN'=99 ?40,RATRAN S RATRAN=99
.. Q
. Q
Q 0
SECRES ; Secondary Resident data
S:RASIR=.001 RATXT="None"
S RASIR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR))
I $D(RATXT),('+RASIR) W RATXT
E D
. S RASIR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR,0))
. W $S($D(^VA(200,+RASIR(0),0)):$P(^(0),"^"),1:"")
. Q
K RATXT
Q
SECSTF ; Secondary Staff data
S:RASIS=.001 RATXT="None"
S RASIS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS))
I $D(RATXT),('+RASIS) W ?40,RATXT
E D
. S RASIS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS,0))
. W ?40,$S($D(^VA(200,+RASIS(0),0)):$P(^(0),"^"),1:"")
. Q
K RATXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPROD1 7181 printed Oct 16, 2024@18:39:25 Page 2
RAPROD1 ;HISC/FPT,GJC AISC/MJK,RMO-Detailed Exam View ;11/26/96 08:24
+1 ;;5.0;Radiology/Nuclear Medicine;**15,18,45,77**;Mar 16, 1998;Build 7
+2 ;last mof by SS for P18 JUN 29 ,00
+3 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - correct paging issue
PER ; Display personnel information.
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
NEW Y
+2 SET DIR(0)="Y"
SET DIR("B")="No"
+3 SET DIR("A")="Do you wish to display all personnel involved"
+4 DO ^DIR
if $DATA(DIRUT)
SET X="^"
+5 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
IF X="^"
DO Q
QUIT
+6 ; (Y=1:Yes,Y=0:No)
if +Y=0
GOTO ACT
+7 SET RAXIT=0
DO PERHDR
+8 SET RAXIT=$$PERINFO(RADFN,RADTI,RACNI)
+9 IF RAXIT
DO Q
QUIT
+10 IF $DATA(RACM)
DO CMHIST^RAPROD2(RADFN,RADTI,RACNI)
+11 IF RAXIT
DO Q
QUIT
ACT READ !!,"Do you wish to display activity log? No// ",X:DTIME
SET X=$EXTRACT(X)
if '$TEST
SET X="^"
if X="^"
GOTO Q
if X=""
SET X="N"
if "Nn"[X
GOTO STAT
IF "Yy"'[X
if X'="?"
WRITE $CHAR(7)
WRITE !!?3,"Enter 'YES' if activity log should be displayed, or 'NO' if not."
GOTO ACT
+1 WRITE !!?23,"*** Exam Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?3,"Technologist comment",!?2,"---------------------",?25,"------",?60,"-------------"
+2 ;P18
NEW RA18RET
SET RADD=70.07
FOR I=0:0
SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"L",I))
if I'>0
QUIT
IF $DATA(^(I,0))
SET RAY=^(0)
SET Y=+RAY
DO ACT1
SET RA18RET=$$PUTTCOM3^RAUTL11(RADFN,RADTI,RACNI,I,"",3,78,7,0,1,6,0)
if RA18RET=-1
SET RAXIT=1
if RA18RET=-1
QUIT
+3 ;P18
IF $DATA(RAXIT)
IF RAXIT
DO Q
QUIT
+4 ;
+5 if 'RARPT
GOTO STAT
WRITE !!?22,"*** Report Activity Log ***",!?2,"Date/Time",?25,"Action",?60,"Computer User",!?2,"---------",?25,"------",?60,"-------------"
+6 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 - added screen length check to next line
+7 SET RADD=74.01
FOR I=0:0
SET I=$ORDER(^RARPT(RARPT,"L",I))
if I'>0
QUIT
IF $DATA(^(I,0))
SET RAY=^(0)
SET Y=+RAY
DO ACT1
IF $$CONTIN^RAUTL11(7)=-1
SET RAXIT=1
QUIT
+8 ;10/25/2006 BAY/KAM Remedy Call 161846, *77 Added next line
+9 IF $GET(RAXIT)
DO Q
QUIT
+10 WRITE !
SET X=""
SET $PIECE(X,"=",80)=""
WRITE X
KILL X
+11 GOTO STAT
ACT1 DO D^RAUTL
WRITE !?2,Y,?25,$EXTRACT($PIECE($PIECE(^DD(RADD,2,0),$PIECE(RAY,"^",2)_":",2),";"),1,33),?60,$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(RAY,"^",3),0)):$PIECE(^(0),"^"),1:"Unknown"),1,18)
QUIT
+1 ;
STAT if '$DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T"))
GOTO TEXT
ASKSTA READ !!,"Do you wish to display exam status tracking log? No// ",X:DTIME
SET X=$EXTRACT(X)
if '$TEST
SET X="^"
if X="^"
GOTO Q
if X=""
SET X="N"
if "Nn"[X
GOTO TEXT
IF "Yy"'[X
if X'="?"
WRITE $CHAR(7)
Begin DoDot:1
+1 WRITE !!?3,"Enter 'YES' if exam status tracking log should be displayed, or 'NO' if not."
+2 QUIT
End DoDot:1
GOTO ASKSTA
+3 ; print header
SET RAXIT=0
DO STATHDR
+4 KILL RAX2
SET RACUM=""
+5 FOR I=0:0
SET I=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",I))
if I'>0
QUIT
IF $DATA(^(I,0))
SET RA=^(0)
SET RAX1=+RA
DO STAT1
if $DATA(RAX2)&('$DATA(RAMTIME))
QUIT
if RAXIT
QUIT
SET RAX2=RAX1
+6 if RAXIT
QUIT
WRITE !
SET X=""
SET $PIECE(X,"=",80)=""
WRITE X
KILL X
TEXT SET X=$EXTRACT(RA("RST"))
if X="P"!(X="N")!(X="D")
GOTO Q
ASKTXT READ !!,"Do you wish to display exam report text? No// ",X:DTIME
SET X=$EXTRACT(X)
if '$TEST!(X="")!(X="^")
SET X="N"
if "Nn"[X
GOTO Q
IF "Yy"'[X
if X'="?"
WRITE $CHAR(7)
WRITE !!?3,"Enter 'YES' if report text should be displayed, or 'NO' if not."
GOTO ASKTXT
+1 DO DISP^RART1
Q ; kill and quit
+1 KILL 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
+2 KILL RAXIT,RACM
+3 QUIT
STAT1 ; display status tracking info
+1 KILL RAELAP
IF $DATA(RAX2)
SET X1=RAX1
SET X=RAX2
DO ELAPSED^RAUTL1
if '$DATA(RAMTIME)
QUIT
SET RAELAP=Y
DO CUMUL
+2 SET Y=RAX1
DO D^RAUTL
+3 if $DATA(RAELAP)
WRITE ?49,RAELAP,?65,RACUM
+4 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO STATHDR
+5 WRITE !?2,$SELECT($DATA(^RA(72,+$PIECE(RA,"^",2),0)):$EXTRACT($PIECE(^(0),"^"),1,20),1:"Unknown"),?25,Y
+6 QUIT
CUMUL ; calculate time frame
+1 if $EXTRACT(Y)="N"
QUIT
FOR RAI=1:1:3
SET RA(RAI)=+$PIECE(RACUM,":",RAI)+$PIECE(Y,":",RAI)
+2 FOR RAI=3:-1:2
if RA(RAI)>59
SET RA(RAI-1)=RA(RAI-1)+1
SET RA(RAI)=RA(RAI)-60
+3 SET RACUM=$EXTRACT(RA(1)+100,2,3)_":"_$EXTRACT(RA(2)+100,2,3)_":"_$EXTRACT(RA(3)+100,2,3)
KILL RAI,RA(1),RA(2),RA(3)
+4 QUIT
STATHDR ; Print status tracking header
+1 if '$DATA(IOF)
DO HOME^%ZIS
WRITE @IOF
+2 WRITE !!,?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,"---------------"
+3 QUIT
PERHDR ; Print personnel header
+1 if '$DATA(IOF)
DO HOME^%ZIS
WRITE @IOF
+2 NEW X,Y
SET X="*** Imaging Personnel ***"
+3 SET $PIECE(Y,"-",(IOM+1))=""
WRITE !?(IOM-$LENGTH(X)\2),X,!,Y
+4 QUIT
PERINFO(RADFN,RADTI,RACNI) ; Personnel information
+1 ; Pass back 0 if ok, 1 if interrupt
+2 if '$LENGTH(RADFN)!('$LENGTH(RADTI))!('$LENGTH(RACNI))
QUIT 1
+3 NEW RA70,RAHD1,RAHD2,RAHD3,RAPIR,RAPIS,RAPRE,RARP,RARPT,RASIR,RASIS
+4 NEW RATECH,RATRAN,RAVER
+5 SET RA70=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+6 SET RARPT=+$PIECE(RA70,"^",17)
if 'RARPT
SET RATRAN="No Report"
+7 if 'RARPT
SET (RAPRE,RAVER,RAPRE("DT"),RAVER("DT"))=""
+8 IF RARPT
Begin DoDot:1
+9 SET RARPT(0)=$GET(^RARPT(RARPT,0))
+10 SET RARPT("T")=$GET(^RARPT(RARPT,"T"))
+11 SET RATRAN=$SELECT($DATA(^VA(200,+RARPT("T"),0)):$PIECE(^(0),"^"),1:"")
+12 SET RAPRE=$SELECT($DATA(^VA(200,+$PIECE(RARPT(0),"^",13),0)):$PIECE(^(0),"^"),1:"")
+13 SET RAVER=$SELECT($DATA(^VA(200,+$PIECE(RARPT(0),"^",9),0)):$PIECE(^(0),"^"),1:"")
+14 SET RAPRE("DT")=$TRANSLATE($$FMTE^XLFDT($PIECE(RARPT(0),"^",12),"2F")," /","0")
+15 SET RAVER("DT")=$TRANSLATE($$FMTE^XLFDT($PIECE(RARPT(0),"^",7),"2F")," /","0")
+16 QUIT
End DoDot:1
+17 SET RAPIR=$SELECT($DATA(^VA(200,+$PIECE(RA70,"^",12),0)):$PIECE(^(0),"^"),1:"")
+18 SET RAPIS=$SELECT($DATA(^VA(200,+$PIECE(RA70,"^",15),0)):$PIECE(^(0),"^"),1:"")
+19 SET RASIR=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
+20 SET RASIS=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
+21 SET RATECH=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0))
+22 WRITE !,"Primary Int'g Resident: ",RAPIR
+23 WRITE !,"Primary Int'g Staff : ",RAPIS
+24 WRITE !,"Pre-Verifier: ",RAPRE," ",RAPRE("DT")
+25 WRITE !,"Verifier : ",RAVER," ",RAVER("DT"),!
+26 SET RAHD1="W !,""Secondary Interpreting Resident"",?40,""Secondary Interpreting Staff"""
+27 SET RAHD2="W !,""-------------------------------"",?40,""----------------------------"""
+28 XECUTE RAHD1
XECUTE RAHD2
+29 IF 'RASIR
IF ('RASIS)
WRITE !,"None",?40,"None"
+30 IF '$TEST
Begin DoDot:1
+31 SET (RASIR,RASIS)=.001
+32 FOR
Begin DoDot:2
+33 IF $Y>(IOSL-4)
Begin DoDot:3
+34 SET RAXIT=$$EOS^RAUTL5()
+35 IF 'RAXIT
DO PERHDR
XECUTE RAHD1
XECUTE RAHD2
+36 QUIT
End DoDot:3
if RAXIT
QUIT
+37 WRITE !
if RASIR
DO SECRES
if RASIS
DO SECSTF
+38 QUIT
End DoDot:2
if (('RASIR)&('RASIS))!(RAXIT)
QUIT
+39 QUIT
End DoDot:1
if RAXIT
QUIT 1
+40 IF $Y>(IOSL-4)
Begin DoDot:1
+41 SET RAXIT=$$EOS^RAUTL5()
+42 if 'RAXIT
DO PERHDR
+43 QUIT
End DoDot:1
if RAXIT
QUIT 1
+44 WRITE !
SET RAHD3="W !,""Technologist(s) Transcriptionist"",!,""--------------- ----------------"""
XECUTE RAHD3
+45 IF 'RATECH
WRITE !,"None",?40,RATRAN
+46 IF '$TEST
Begin DoDot:1
+47 NEW RA
SET RA=0
+48 FOR
SET RA=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA))
if RA'>0
QUIT
Begin DoDot:2
+49 SET RATECH(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA,0))
+50 SET RATECH=$SELECT($DATA(^VA(200,+RATECH(0),0)):$PIECE(^(0),"^"),1:"")
+51 IF $Y>(IOSL-4)
Begin DoDot:3
+52 SET RAXIT=$$EOS^RAUTL5()
+53 IF 'RAXIT
DO PERHDR
XECUTE RAHD3
+54 QUIT
End DoDot:3
if RAXIT
QUIT
+55 WRITE !,RATECH
if RATRAN'=99
WRITE ?40,RATRAN
SET RATRAN=99
+56 QUIT
End DoDot:2
if RAXIT
QUIT
+57 QUIT
End DoDot:1
if RAXIT
QUIT 1
+58 QUIT 0
SECRES ; Secondary Resident data
+1 if RASIR=.001
SET RATXT="None"
+2 SET RASIR=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR))
+3 IF $DATA(RATXT)
IF ('+RASIR)
WRITE RATXT
+4 IF '$TEST
Begin DoDot:1
+5 SET RASIR(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASIR,0))
+6 WRITE $SELECT($DATA(^VA(200,+RASIR(0),0)):$PIECE(^(0),"^"),1:"")
+7 QUIT
End DoDot:1
+8 KILL RATXT
+9 QUIT
SECSTF ; Secondary Staff data
+1 if RASIS=.001
SET RATXT="None"
+2 SET RASIS=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS))
+3 IF $DATA(RATXT)
IF ('+RASIS)
WRITE ?40,RATXT
+4 IF '$TEST
Begin DoDot:1
+5 SET RASIS(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASIS,0))
+6 WRITE ?40,$SELECT($DATA(^VA(200,+RASIS(0),0)):$PIECE(^(0),"^"),1:"")
+7 QUIT
End DoDot:1
+8 KILL RATXT
+9 QUIT
