- 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 Jan 18, 2025@03:40:27 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