Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RARTR1

RARTR1.m

Go to the documentation of this file.
  1. 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
  1. ;Supported IA #1571 ^LEX(757.01
  1. ;Supported IA #10104 REPEAT^XLFSTR
  1. ;Supported IA #10060 and #2056 $$GET1^DIQ for file 200
  1. ;last modification by SS for P18 JUNE 29,00
  1. PRTDX ; print dx codes on report
  1. N RATMP,RATMP1
  1. I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
  1. I '$D(RAUTOE) D
  1. . W !?RATAB,"Primary Diagnostic Code: ",!?RATAB+4
  1. . W $S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
  1. . ;p206/KLM - EXPRESSION field (#6) deprecated. Use DISPLAY TEXT field (#100)
  1. . ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
  1. . S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
  1. . W:RATMP]"" " (",RATMP,")"
  1. . Q
  1. I $D(RAUTOE) D
  1. . S RATMP1=" Primary Diagnostic Code: "
  1. . S RATMP1=RATMP1_$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"")
  1. . ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
  1. . S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
  1. . I RATMP]"" S RATMP1=RATMP1_" ("_RATMP_")"
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
  1. . Q
  1. I '$D(RAUTOE) D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. I '$D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) W ! Q
  1. I '$D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
  1. . W !!?RATAB,"Secondary Diagnostic Codes: "
  1. . S RADXCODE=0
  1. . 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
  1. .. D HANG^RARTR2:($Y+RAFOOT+4)>IOSL Q:$D(RAOOUT)
  1. .. D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. .. W !?RATAB+4,$P(^RA(78.3,RADXCODE,0),U,1)
  1. .. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
  1. .. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
  1. .. W:RATMP]"" " (",RATMP,")"
  1. .. Q
  1. . K RADXCODE W !
  1. . Q
  1. I $D(RAUTOE),('$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D Q
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. I $D(RAUTOE),($O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0))) D
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Secondary Diagnostic Codes: "
  1. . S RADXCODE=0
  1. . F S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0 D
  1. .. Q:'$D(^RA(78.3,+$G(RADXCODE),0))#2
  1. .. ;S RATMP=$$GET1^DIQ(757.01,$P($G(^RA(78.3,+RADXCODE,0)),U,6),.01) ;p206 comment out
  1. .. S RATMP=$P($G(^RA(78.3,+RADXCODE,1)),U) ;p206
  1. .. S RATMP1=" "_$P(^RA(78.3,+$G(RADXCODE),0),U)
  1. .. S RATMP1=RATMP1_$S(RATMP="":"",1:" ("_RATMP_")")
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATMP1
  1. .. Q
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. Q
  1. WARNING ; this printed report should not be used for charting
  1. S RARPTSTT=$$RSTAT^RAO7PC1A()
  1. S:RARPTSTT="NO REPORT" RARPTSTT="REPORT STATUS UNKNOWN"
  1. S:RAST="R" RARPTSTT="("_RARPTSTT_")"
  1. S RAPOSITN=(80-$L(RARPTSTT)\2)
  1. I '$D(RAUTOE) D ;P18 modif
  1. . W !?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
  1. . W:RAST="R" !?(80-$L(RARPTSTT)\2)-1,"* PRELIMINARY REPORT *" ;P18
  1. . W !?(80-$L(RARPTSTT)\2)-1,"*"_RARPTSTT_"*",!?RAPOSITN-1,$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
  1. . Q
  1. I $D(RAUTOE) D
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
  1. . I RAST="R" S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="* PRELIMINARY REPORT *" ;P18
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="*"_RARPTSTT_"*" ;P18
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$$REPEAT^XLFSTR("*",$L(RARPTSTT)+2)
  1. . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
  1. . Q
  1. K RAPOSITN,RARPTSTT
  1. Q
  1. SECRES ; Print from the secondary resident multiple
  1. Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0)) ; no data, quit
  1. N RASR,RASRSBN,RASRSBT,DIERR,RAZ
  1. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. W:'$D(RAUTOE) !,"Secondary Interpreting Resident:"
  1. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Resident:"
  1. S RASR=0
  1. F S RASR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR)) Q:RASR'>0 D
  1. . S RASR(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASR,0))
  1. . S RAZ=$$GET1^DIQ(200,+RASR(0)_",",.01)
  1. . Q:RAZ=""
  1. . S RASRSBN=$E($$GET1^DIQ(200,+RASR(0)_",",20.2),1,25)
  1. . S:RASRSBN']"" RASRSBN=$E(RAZ,1,25)
  1. . S RASRSBT=$$GET1^DIQ(200,+RASR(0)_",",20.3) ; max:; 50 chars
  1. . I RASRSBT']"" S RASRSBT=$$TITLE^RARTR0(+RASR(0))
  1. . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. . W:'$D(RAUTOE) !?2,$S(RASRSBN]"":RASRSBN,1:"Unknown"),", ",$E(RASRSBT,1,((IOM-$X)-16))
  1. . ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
  1. . I $D(RAUTOE) D
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASRSBN]"":RASRSBN,1:"Unknown")
  1. .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
  1. .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASRSBT,1,((80-RALEN)-16))
  1. .. Q
  1. . I '$D(RAVERFND),(RAVERF=+RASR(0)) D
  1. .. S RAVERFND=""
  1. .. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
  1. ... W:RAWHOVER=+RASR(0) !?10,"(Verifier, no e-sig)"
  1. ... W:RAWHOVER'=+RASR(0) !?10,"Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
  1. ... Q
  1. .. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
  1. ... S:RAWHOVER=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
  1. ... S:RAWHOVER'=+RASR(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASRSBN ;Removed RA*5*8 _", M.D."
  1. ... Q
  1. .. W:'$D(RAUTOE) " (Verifier)"
  1. .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
  1. .. Q
  1. . I RAPVERF=+RASR(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
  1. . Q
  1. Q
  1. SECSTF ; Print from the secondary staff multiple
  1. Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0)) ; no data, quit
  1. N RASS,RASSSBN,RASSSBT,DIERR,RAZ
  1. I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. W:'$D(RAUTOE) !,"Secondary Interpreting Staff:"
  1. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Secondary Interpreting Staff:"
  1. S RASS=0
  1. F S RASS=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS)) Q:RASS'>0 D
  1. . S RASS(0)=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASS,0))
  1. . S RAZ=$$GET1^DIQ(200,+RASS(0)_",",.01)
  1. . Q:RAZ=""
  1. . S RASSSBN=$E($$GET1^DIQ(200,+RASS(0)_",",20.2),1,25)
  1. . S:RASSSBN="" RASSSBN=$E(RAZ,1,25)
  1. . S RASSSBT=$$GET1^DIQ(200,+RASS(0)_",",20.3) ; max: 50 chars
  1. . I RASSSBT']"" S RASSSBT=$$TITLE^RARTR0(+RASS(0))
  1. . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  1. . W:'$D(RAUTOE) !?2,$S(RASSSBN]"":RASSSBN,1:"Unknown"),", ",$E(RASSSBT,1,((IOM-$X)-16))
  1. . ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
  1. . I $D(RAUTOE) D
  1. .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RASSSBN]"":RASSSBN,1:"Unknown")
  1. .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
  1. .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RASSSBT,1,((80-RALEN)-16))
  1. .. Q
  1. . I '$D(RAVERFND),(RAVERF=+RASS(0)) D
  1. .. S RAVERFND=""
  1. .. I $G(RARPT(10))']"",('$D(RAUTOE)) D Q
  1. ... W:RAWHOVER=+RASS(0) !?10,"(Verifier, no e-sig)"
  1. ... W:RAWHOVER'=+RASS(0) !?10,"Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
  1. ... Q
  1. .. I $G(RARPT(10))']"",($D(RAUTOE)) D Q
  1. ... S:RAWHOVER=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" (Verifier, no e-sig)"
  1. ... S:RAWHOVER'=+RASS(0) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" Verified by transcriptionist for "_RASSSBN ;Removed RA*5*8 _", M.D."
  1. ... Q
  1. .. W:'$D(RAUTOE) " (Verifier)"
  1. .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
  1. .. Q
  1. . I RAPVERF=+RASS(0) W:'$D(RAUTOE) " (Pre-Verifier)" S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
  1. . Q
  1. Q