RARTR1 ;HISC/FPT,GJC-Queue/print Radiology Reports (cont.) ; Sep 11, 2023@14:03:48
;;5.0;Radiology/Nuclear Medicine;**8,18,56,97,206**;Mar 16, 1998;Build 8
;Supported IA #1571 ^LEX(757.01
;Supported IA #10104 REPEAT^XLFSTR
;Supported IA #10060 and #2056 $$GET1^DIQ for file 200
;last modification by SS for P18 JUNE 29,00
PRTDX ; print dx codes on report
N RATMP,RATMP1
I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
I '$D(RAUTOE) D
. W !?RATAB,"Primary Diagnostic Code: ",!?RATAB+4
. W $S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
. ;p206/KLM - EXPRESSION field (#6) deprecated. Use DISPLAY TEXT field (#100)
. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
. W:RATMP]"" " (",RATMP,")"
. Q
I $D(RAUTOE) D
. S RATMP1=" Primary Diagnostic Code: "
. S RATMP1=RATMP1_$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
. I RATMP]"" S RATMP1=RATMP1_" ("_RATMP_")"
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
. Q
I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
I '$D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) W ! Q
I '$D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
. W !!?RATAB,"Secondary Diagnostic Codes: "
. S RADXCODE=0
. F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0!('$D(^RA(78.3,+RADXCODE,0)))!($D(RAOOUT)) D
.. D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT)
.. D HD^RARTR:($Y+RAFOOT+4)>IOSL
.. W !?RATAB+4,$P(^RA(78.3,RADXCODE,0),U,1)
.. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
.. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
.. W:RATMP]"" " (",RATMP,")"
.. Q
. K RADXCODE W !
. Q
I $D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
. Q
I $D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Secondary Diagnostic Codes: "
. S RADXCODE=0
. F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0 D
.. Q:'$D(^RA(78.3,+$G(RADXCODE),0))#2
.. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
.. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
.. S RATMP1=" "_$P(^RA(78.3,+$G(RADXCODE),0),U)
.. S RATMP1=RATMP1_$S(RATMP="":"",1:" ("_RATMP_")")
.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
.. Q
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
. Q
Q
WARNING ; this printed report should not be used for charting
S RARPTSTT=$$RSTAT^RAO7PC1A()
S:RARPTSTT="NO REPORT" RARPTSTT="REPORT STATUS UNKNOWN"
S:RAST="R" RARPTSTT="("_RARPTSTT_")"
S RAPOSITN=(80-$L(RARPTSTT)\2)
I '$D(RAUTOE) D ;P18 modif
. W !?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
. W:RAST="R" !?(80-$L(RARPTSTT)\2)-1,"* PRELIMINARY REPORT *" ;P18
. W !?(80-$L(RARPTSTT)\2)-1,"*"_RARPTSTT_"*",!?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
. Q
I $D(RAUTOE) D
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
. I RAST="R" S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="* PRELIMINARY REPORT *" ;P18
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="*"_RARPTSTT_"*" ;P18
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
. Q
K RAPOSITN,RARPTSTT
Q
SECRES ; Print from the secondary resident multiple
Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0)) ; no data, quit
N RASR,RASRSBN,RASRSBT,DIERR,RAZ
I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
W:'$D(RAUTOE) !,"Secondary Interpreting Resident:"
S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Resident:"
S RASR=0
F S RASR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR)) Q:RASR'>0 D
. S RASR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR,0))
. S RAZ=$$GET1^DIQ(200,+RASR(0)_",",.01)
. Q:RAZ=""
. S RASRSBN=$E($$GET1^DIQ(200,+RASR(0)_",",20.2),1,25)
. S:RASRSBN']"" RASRSBN=$E(RAZ,1,25)
. S RASRSBT=$$GET1^DIQ(200,+RASR(0)_",",20.3) ; max:; 50 chars
. I RASRSBT']"" S RASRSBT=$$TITLE^RARTR0(+RASR(0))
. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
. W:'$D(RAUTOE) !?2,$S(RASRSBN]"":RASRSBN,1:"Unknown"),", ",$E(RASRSBT,1,((IOM-$X)-16))
. ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
. I $D(RAUTOE) D
.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASRSBN]"":RASRSBN,1:"Unknown")
.. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
.. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASRSBT,1,((80-RALEN)-16))
.. Q
. I '$D(RAVERFND),(RAVERF=+RASR(0)) D
.. S RAVERFND=""
.. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
... W:RAWHOVER=+RASR(0) !?10,"(Verifier, no e-sig)"
... W:RAWHOVER'=+RASR(0) !?10,"Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
... Q
.. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
... S:RAWHOVER=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
... S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
... Q
.. W:'$D(RAUTOE) " (Verifier)"
.. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
.. Q
. I RAPVERF=+RASR(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
. Q
Q
SECSTF ; Print from the secondary staff multiple
Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0)) ; no data, quit
N RASS,RASSSBN,RASSSBT,DIERR,RAZ
I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
W:'$D(RAUTOE) !,"Secondary Interpreting Staff:"
S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Staff:"
S RASS=0
F S RASS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS)) Q:RASS'>0 D
. S RASS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS,0))
. S RAZ=$$GET1^DIQ(200,+RASS(0)_",",.01)
. Q:RAZ=""
. S RASSSBN=$E($$GET1^DIQ(200,+RASS(0)_",",20.2),1,25)
. S:RASSSBN="" RASSSBN=$E(RAZ,1,25)
. S RASSSBT=$$GET1^DIQ(200,+RASS(0)_",",20.3) ; max: 50 chars
. I RASSSBT']"" S RASSSBT=$$TITLE^RARTR0(+RASS(0))
. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
. W:'$D(RAUTOE) !?2,$S(RASSSBN]"":RASSSBN,1:"Unknown"),", ",$E(RASSSBT,1,((IOM-$X)-16))
. ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
. I $D(RAUTOE) D
.. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASSSBN]"":RASSSBN,1:"Unknown")
.. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
.. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASSSBT,1,((80-RALEN)-16))
.. Q
. I '$D(RAVERFND),(RAVERF=+RASS(0)) D
.. S RAVERFND=""
.. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
... W:RAWHOVER=+RASS(0) !?10,"(Verifier, no e-sig)"
... W:RAWHOVER'=+RASS(0) !?10,"Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
... Q
.. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
... S:RAWHOVER=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
... S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
... Q
.. W:'$D(RAUTOE) " (Verifier)"
.. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
.. Q
. I RAPVERF=+RASS(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTR1 8119 printed Oct 16, 2024@18:40:02 Page 2
RARTR1 ;HISC/FPT,GJC-Queue/print Radiology Reports (cont.) ; Sep 11, 2023@14:03:48
+1 ;;5.0;Radiology/Nuclear Medicine;**8,18,56,97,206**;Mar 16, 1998;Build 8
+2 ;Supported IA #1571 ^LEX(757.01
+3 ;Supported IA #10104 REPEAT^XLFSTR
+4 ;Supported IA #10060 and #2056 $$GET1^DIQ for file 200
+5 ;last modification by SS for P18 JUNE 29,00
PRTDX ; print dx codes on report
+1 NEW RATMP,RATMP1
+2 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+3 SET RADXCODE=$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
+4 IF '$DATA(RAUTOE)
Begin DoDot:1
+5 WRITE !?RATAB,"Primary Diagnostic Code: ",!?RATAB+4
+6 WRITE $SELECT($DATA(^RA(78.3,+RADXCODE,0)):$PIECE(^(0),U,1),1:"")
+7 ;p206/KLM - EXPRESSION field (#6) deprecated. Use DISPLAY TEXT field (#100)
+8 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
+9 ;p206
SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
+10 if RATMP]""
WRITE " (",RATMP,")"
+11 QUIT
End DoDot:1
+12 IF $DATA(RAUTOE)
Begin DoDot:1
+13 SET RATMP1=" Primary Diagnostic Code: "
+14 SET RATMP1=RATMP1_$SELECT($DATA(^RA(78.3,+RADXCODE,0)):$PIECE(^(0),U,1),1:"")
+15 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
+16 ;p206
SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
+17 IF RATMP]""
SET RATMP1=RATMP1_" ("_RATMP_")"
+18 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
+19 QUIT
End DoDot:1
+20 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+21 IF '$DATA(RAUTOE)
IF ('$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
WRITE !
QUIT
+22 IF '$DATA(RAUTOE)
IF ($ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+23 WRITE !!?RATAB,"Secondary Diagnostic Codes: "
+24 SET RADXCODE=0
+25 FOR
SET RADXCODE=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE))
if RADXCODE'>0!('$DATA(^RA(78.3,+RADXCODE,0)))!($DATA(RAOOUT))
QUIT
Begin DoDot:2
+26 if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
+27 if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+28 WRITE !?RATAB+4,$PIECE(^RA(78.3,RADXCODE,0),U,1)
+29 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
+30 ;p206
SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
+31 if RATMP]""
WRITE " (",RATMP,")"
+32 QUIT
End DoDot:2
+33 KILL RADXCODE
WRITE !
+34 QUIT
End DoDot:1
QUIT
+35 IF $DATA(RAUTOE)
IF ('$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+36 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+37 QUIT
End DoDot:1
QUIT
+38 IF $DATA(RAUTOE)
IF ($ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+39 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Secondary Diagnostic Codes: "
+40 SET RADXCODE=0
+41 FOR
SET RADXCODE=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE))
if RADXCODE'>0
QUIT
Begin DoDot:2
+42 if '$DATA(^RA(78.3,+$GET(RADXCODE),0))#2
QUIT
+43 ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
+44 ;p206
SET RATMP=$PIECE($GET(^RA(78.3,+RADXCODE,1)),U)
+45 SET RATMP1=" "_$PIECE(^RA(78.3,+$GET(RADXCODE),0),U)
+46 SET RATMP1=RATMP1_$SELECT(RATMP="":"",1:" ("_RATMP_")")
+47 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
+48 QUIT
End DoDot:2
+49 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+50 QUIT
End DoDot:1
+51 QUIT
WARNING ; this printed report should not be used for charting
+1 SET RARPTSTT=$$RSTAT^RAO7PC1A()
+2 if RARPTSTT="NO REPORT"
SET RARPTSTT="REPORT STATUS UNKNOWN"
+3 if RAST="R"
SET RARPTSTT="("_RARPTSTT_")"
+4 SET RAPOSITN=(80-$LENGTH(RARPTSTT)\2)
+5 ;P18 modif
IF '$DATA(RAUTOE)
Begin DoDot:1
+6 WRITE !?RAPOSITN-1,$$REPEAT^XLFSTR("*",$LENGTH(RARPTSTT)+2)
+7 ;P18
if RAST="R"
WRITE !?(80-$LENGTH(RARPTSTT)\2)-1,"* PRELIMINARY REPORT *"
+8 WRITE !?(80-$LENGTH(RARPTSTT)\2)-1,"*"_RARPTSTT_"*",!?RAPOSITN-1,$$REPEAT^XLFSTR("*",$LENGTH(RARPTSTT)+2)
+9 QUIT
End DoDot:1
+10 IF $DATA(RAUTOE)
Begin DoDot:1
+11 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$LENGTH(RARPTSTT)+2)
+12 ;P18
IF RAST="R"
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="* PRELIMINARY REPORT *"
+13 ;P18
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="*"_RARPTSTT_"*"
+14 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$LENGTH(RARPTSTT)+2)
+15 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+16 QUIT
End DoDot:1
+17 KILL RAPOSITN,RARPTSTT
+18 QUIT
SECRES ; Print from the secondary resident multiple
+1 ; no data, quit
if '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
QUIT
+2 NEW RASR,RASRSBN,RASRSBT,DIERR,RAZ
+3 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+4 if '$DATA(RAUTOE)
WRITE !,"Secondary Interpreting Resident:"
+5 if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Resident:"
+6 SET RASR=0
+7 FOR
SET RASR=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR))
if RASR'>0
QUIT
Begin DoDot:1
+8 SET RASR(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR,0))
+9 SET RAZ=$$GET1^DIQ(200,+RASR(0)_",",.01)
+10 if RAZ=""
QUIT
+11 SET RASRSBN=$EXTRACT($$GET1^DIQ(200,+RASR(0)_",",20.2),1,25)
+12 if RASRSBN']""
SET RASRSBN=$EXTRACT(RAZ,1,25)
+13 ; max:; 50 chars
SET RASRSBT=$$GET1^DIQ(200,+RASR(0)_",",20.3)
+14 IF RASRSBT']""
SET RASRSBT=$$TITLE^RARTR0(+RASR(0))
+15 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+16 if '$DATA(RAUTOE)
WRITE !?2,$SELECT(RASRSBN]"":RASRSBN,1:"Unknown"),", ",$EXTRACT(RASRSBT,1,((IOM-$X)-16))
+17 ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
+18 IF $DATA(RAUTOE)
Begin DoDot:2
+19 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$SELECT(RASRSBN]"":RASRSBN,1:"Unknown")
+20 NEW RALEN
SET RALEN=$LENGTH(^TMP($JOB,"RA AUTOE",RAACNT))
+21 SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_", "_$EXTRACT(RASRSBT,1,((80-RALEN)-16))
+22 QUIT
End DoDot:2
+23 IF '$DATA(RAVERFND)
IF (RAVERF=+RASR(0))
Begin DoDot:2
+24 SET RAVERFND=""
+25 IF $GET(RARPT(10))']""
IF ('$DATA(RAUTOE))
Begin DoDot:3
+26 if RAWHOVER=+RASR(0)
WRITE !?10,"(Verifier, no e-sig)"
+27 ;Removed RA*5*8 _", M.D."
if RAWHOVER'=+RASR(0)
WRITE !?10,"Verified by transcriptionist for "_RASRSBN
+28 QUIT
End DoDot:3
QUIT
+29 IF $GET(RARPT(10))']""
IF ($DATA(RAUTOE))
Begin DoDot:3
+30 if RAWHOVER=+RASR(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
+31 ;Removed RA*5*8 _", M.D."
if RAWHOVER'=+RASR(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN
+32 QUIT
End DoDot:3
QUIT
+33 if '$DATA(RAUTOE)
WRITE " (Verifier)"
+34 if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Verifier)"
+35 QUIT
End DoDot:2
+36 IF RAPVERF=+RASR(0)
if '$DATA(RAUTOE)
WRITE " (Pre-Verifier)"
if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
+37 QUIT
End DoDot:1
+38 QUIT
SECSTF ; Print from the secondary staff multiple
+1 ; no data, quit
if '$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
QUIT
+2 NEW RASS,RASSSBN,RASSSBT,DIERR,RAZ
+3 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+4 if '$DATA(RAUTOE)
WRITE !,"Secondary Interpreting Staff:"
+5 if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Staff:"
+6 SET RASS=0
+7 FOR
SET RASS=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS))
if RASS'>0
QUIT
Begin DoDot:1
+8 SET RASS(0)=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS,0))
+9 SET RAZ=$$GET1^DIQ(200,+RASS(0)_",",.01)
+10 if RAZ=""
QUIT
+11 SET RASSSBN=$EXTRACT($$GET1^DIQ(200,+RASS(0)_",",20.2),1,25)
+12 if RASSSBN=""
SET RASSSBN=$EXTRACT(RAZ,1,25)
+13 ; max: 50 chars
SET RASSSBT=$$GET1^DIQ(200,+RASS(0)_",",20.3)
+14 IF RASSSBT']""
SET RASSSBT=$$TITLE^RARTR0(+RASS(0))
+15 IF '$DATA(RAUTOE)
if ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
if $DATA(RAOOUT)
QUIT
if ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+16 if '$DATA(RAUTOE)
WRITE !?2,$SELECT(RASSSBN]"":RASSSBN,1:"Unknown"),", ",$EXTRACT(RASSSBT,1,((IOM-$X)-16))
+17 ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
+18 IF $DATA(RAUTOE)
Begin DoDot:2
+19 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$SELECT(RASSSBN]"":RASSSBN,1:"Unknown")
+20 NEW RALEN
SET RALEN=$LENGTH(^TMP($JOB,"RA AUTOE",RAACNT))
+21 SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_", "_$EXTRACT(RASSSBT,1,((80-RALEN)-16))
+22 QUIT
End DoDot:2
+23 IF '$DATA(RAVERFND)
IF (RAVERF=+RASS(0))
Begin DoDot:2
+24 SET RAVERFND=""
+25 IF $GET(RARPT(10))']""
IF ('$DATA(RAUTOE))
Begin DoDot:3
+26 if RAWHOVER=+RASS(0)
WRITE !?10,"(Verifier, no e-sig)"
+27 ;Removed RA*5*8 _", M.D."
if RAWHOVER'=+RASS(0)
WRITE !?10,"Verified by transcriptionist for "_RASSSBN
+28 QUIT
End DoDot:3
QUIT
+29 IF $GET(RARPT(10))']""
IF ($DATA(RAUTOE))
Begin DoDot:3
+30 if RAWHOVER=+RASS(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
+31 ;Removed RA*5*8 _", M.D."
if RAWHOVER'=+RASS(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN
+32 QUIT
End DoDot:3
QUIT
+33 if '$DATA(RAUTOE)
WRITE " (Verifier)"
+34 if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Verifier)"
+35 QUIT
End DoDot:2
+36 IF RAPVERF=+RASS(0)
if '$DATA(RAUTOE)
WRITE " (Pre-Verifier)"
if $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
+37 QUIT
End DoDot:1
+38 QUIT
