RARTR1 ;HISC/FPT,GJC-Queue/print Radiology Reports (cont.) ; 20 Apr 2011 7:03 PM
;;5.0;Radiology/Nuclear Medicine;**8,18,56,97,1003**;Nov 01, 2010;Build 3
;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:"")
. S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01)
. 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)
. 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)
.. 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)
.. 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)"
... ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
... ;Other verifier may not be a transcriptionist
... ;W:RAWHOVER'=+RASR(0) !?10,"Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
... W:RAWHOVER'=+RASR(0) !?10,"Verified by ",$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASRSBN ;Removed RA*5*8 _", M.D."
... ;End Patch
... Q
.. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
... S:RAWHOVER=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
... ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
... ;Other verifier may not be a transcriptionist
... ;S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
... S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by "_$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASRSBN ;Removed RA*5*8 _", M.D."
... ;End Patch
... 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)"
... ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
... ;Other verifier may not be a transcriptionist
... ;W:RAWHOVER'=+RASS(0) !?10,"Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
... W:RAWHOVER'=+RASS(0) !?10,"Verified by ",$$GET1^DIQ(200,+RAWHOVER,.01)," for "_RASSSBN ;Removed RA*5*8 _", M.D."
... ;End Patch
... Q
.. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
... S:RAWHOVER=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
... ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
... ;Other verifier may not be a transcriptionist
... ;S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
... S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by "_$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASSSBN ;Removed RA*5*8 _", M.D."
... ;End Patch
... 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
RARTR1 ;HISC/FPT,GJC-Queue/print Radiology Reports (cont.) ; 20 Apr 2011 7:03 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**8,18,56,97,1003**;Nov 01, 2010;Build 3
+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 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+8 IF RATMP]""
WRITE " (",RATMP,")"
+9 QUIT
End DoDot:1
+10 IF $DATA(RAUTOE)
Begin DoDot:1
+11 SET RATMP1=" Primary Diagnostic Code: "
+12 SET RATMP1=RATMP1_$SELECT($DATA(^RA(78.3,+RADXCODE,0)):$PIECE(^(0),U,1),1:"")
+13 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+14 IF RATMP]""
SET RATMP1=RATMP1_" ("_RATMP_")"
+15 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
+16 QUIT
End DoDot:1
+17 IF '$DATA(RAUTOE)
IF ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
IF $DATA(RAOOUT)
QUIT
IF ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+18 IF '$DATA(RAUTOE)
IF ('$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
WRITE !
QUIT
+19 IF '$DATA(RAUTOE)
IF ($ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+20 WRITE !!?RATAB,"Secondary Diagnostic Codes: "
+21 SET RADXCODE=0
+22 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
+23 IF ($Y+RAFOOT+4)>IOSL
DO HANG^RARTR2
IF $DATA(RAOOUT)
QUIT
+24 IF ($Y+RAFOOT+4)>IOSL
DO HD^RARTR
+25 WRITE !?RATAB+4,$PIECE(^RA(78.3,RADXCODE,0),U,1)
+26 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+27 IF RATMP]""
WRITE " (",RATMP,")"
+28 QUIT
End DoDot:2
+29 KILL RADXCODE
WRITE !
+30 QUIT
End DoDot:1
QUIT
+31 IF $DATA(RAUTOE)
IF ('$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+32 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+33 QUIT
End DoDot:1
QUIT
+34 IF $DATA(RAUTOE)
IF ($ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)))
Begin DoDot:1
+35 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Secondary Diagnostic Codes: "
+36 SET RADXCODE=0
+37 FOR
SET RADXCODE=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE))
IF RADXCODE'>0
QUIT
Begin DoDot:2
+38 IF '$DATA(^RA(78.3,+$GET(RADXCODE),0))#2
QUIT
+39 SET RATMP=$$GET1^DIQ(757.01,$PIECE($GET(^RA(78.3,+RADXCODE,0)),U,6),.01)
+40 SET RATMP1=" "_$PIECE(^RA(78.3,+$GET(RADXCODE),0),U)
+41 SET RATMP1=RATMP1_$SELECT(RATMP="":"",1:" ("_RATMP_")")
+42 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
+43 QUIT
End DoDot:2
+44 SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
+45 QUIT
End DoDot:1
+46 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 ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
+28 ;Other verifier may not be a transcriptionist
+29 ;W:RAWHOVER'=+RASR(0) !?10,"Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
+30 ;Removed RA*5*8 _", M.D."
IF RAWHOVER'=+RASR(0)
WRITE !?10,"Verified by ",$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASRSBN
+31 ;End Patch
+32 QUIT
End DoDot:3
QUIT
+33 IF $GET(RARPT(10))']""
IF ($DATA(RAUTOE))
Begin DoDot:3
+34 IF RAWHOVER=+RASR(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
+35 ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
+36 ;Other verifier may not be a transcriptionist
+37 ;S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
+38 ;Removed RA*5*8 _", M.D."
IF RAWHOVER'=+RASR(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by "_$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASRSBN
+39 ;End Patch
+40 QUIT
End DoDot:3
QUIT
+41 IF '$DATA(RAUTOE)
WRITE " (Verifier)"
+42 IF $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Verifier)"
+43 QUIT
End DoDot:2
+44 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)"
+45 QUIT
End DoDot:1
+46 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 ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
+28 ;Other verifier may not be a transcriptionist
+29 ;W:RAWHOVER'=+RASS(0) !?10,"Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
+30 ;Removed RA*5*8 _", M.D."
IF RAWHOVER'=+RASS(0)
WRITE !?10,"Verified by ",$$GET1^DIQ(200,+RAWHOVER,.01)," for "_RASSSBN
+31 ;End Patch
+32 QUIT
End DoDot:3
QUIT
+33 IF $GET(RARPT(10))']""
IF ($DATA(RAUTOE))
Begin DoDot:3
+34 IF RAWHOVER=+RASS(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
+35 ;IHS/BJI/DAY - Patch 1003 - display verifier if not Radiologist
+36 ;Other verifier may not be a transcriptionist
+37 ;S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
+38 ;Removed RA*5*8 _", M.D."
IF RAWHOVER'=+RASS(0)
SET ^TMP($JOB,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by "_$$GET1^DIQ(200,+RAWHOVER,.01)_" for "_RASSSBN
+39 ;End Patch
+40 QUIT
End DoDot:3
QUIT
+41 IF '$DATA(RAUTOE)
WRITE " (Verifier)"
+42 IF $DATA(RAUTOE)
SET ^TMP($JOB,"RA AUTOE",RAACNT)=^TMP($JOB,"RA AUTOE",RAACNT)_" (Verifier)"
+43 QUIT
End DoDot:2
+44 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)"
+45 QUIT
End DoDot:1
+46 QUIT
