Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR0.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR0.m (modified) (5 diffs)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR0.m

@@ -1 +1 @@
 RARTR0 ;HISC/GJC-Queue/Print Radiology Rpts utility routine. ;1/8/97  08:07
- ;;5.0;Radiology/Nuclear Medicine;**8,26,74,84**;Mar 16, 1998;Build 13
+ ;;5.0;Radiology/Nuclear Medicine;**8,26,74**;Mar 16, 1998;Build 2
  ; 06/28/2006 BAY/KAM Remedy Call 146291 - Change Patient Age to DOB
- ;
- ;Integration Agreements
- ;----------------------
- ;DT^DILF(2054); GETS^DIQ(2056); $$FMTE^XLFDT(10103); $$UP^XLFSTR(10104)
- ;NEW PERSON file read w/FM (10060)
- ;
-EN1 ; Called from RARTR ;P84 GETS^DIQ added... 
+EN1 ; Called from RARTR
  S RARPT(0)=$G(^RARPT(+$G(RARPT),0)) Q:RARPT(0)']""
  S RARPT(10)=$P(RARPT(0),"^",10)
  S RAVERF=+$P(RARPT(0),U,9),RAPVERF=+$P(RARPT(0),U,13)
- K RAPIR,RAPIS S RAPIR=+$P(RALB,"^",12),RAPIS=+$P(RALB,"^",15)
- ;format of the RAPIR/RAPIS arrays: P84 logic
- ;RAPI*=IEN file 200
- ;RAPI*(200,RAPI*,.01)= NAME (required)
- ;RAPI*(200,RAPI*,20.2) = SIGNATURE BLOCK PRINTED NAME (if any)
- ;RAPI*(200,RAPI*,20.3) = SIGNATURE BLOCK TITLE (if any)
- I RAPIR D GETS^DIQ(200,RAPIR,".01;20.2;20.3","","RAPIR") S RAPIR("IENS")=RAPIR_","
- I RAPIS D GETS^DIQ(200,RAPIS,".01;20.2;20.3","","RAPIS") S RAPIS("IENS")=RAPIS_","
+ S RAPIR=+$P(RALB,"^",12),RAPIS=+$P(RALB,"^",15)
  S RAWHOVER=+$P(RARPT(0),"^",17)
  I RAVERF,((RAPIR=RAVERF)!(RAPIS=RAVERF)) D
@@ -25 +12 @@
  . Q
  I RAPIS D  Q:$D(RAOOUT)
- . ;get signature block name if defined
- . S RALBS=$E(RAPIS(200,RAPIS("IENS"),20.2),1,25)
- . S:RALBS="" RALBS=$E(RAPIS(200,RAPIS("IENS"),.01),1,25) ;default to NAME
- . ;
- . ;get signature block title if defined
- . S RALBST=$G(RAPIS(200,RAPIS("IENS"),20.3)) ; max: 50 chars
- . S:RALBST="" RALBST=$$TITLE^RARTR0(RAPIS)
- . ;
+ . S RALBS=$E($P($G(^VA(200,RAPIS,20)),"^",2),1,25)
+ . S:RALBS']"" RALBS=$E($P($G(VA(200,RAPIS,0)),"^"),1,25)
+ . S RALBST=$P($G(^VA(200,RAPIS,20)),"^",3) ; max: 50 chars
+ . I RALBST']"" S RALBST=$$TITLE^RARTR0(RAPIS)
  . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
  . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
  . I '$D(RAUTOE) D
- .. W !,"Primary Interpreting Staff:",!?2,$S(RALBS]"":RALBS,1:"Unknown")
- .. W:$L(RALBST) ", "_$E(RALBST,1,((IOM-$X)-16))
+ .. W !,"Primary Interpreting Staff:"
+ .. W !?2,$S(RALBS]"":RALBS,1:"Unknown"),", ",$E(RALBST,1,((IOM-$X)-16))
  .. ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
  .. Q
@@ -43 +26 @@
  .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Primary Interpreting Staff:"
  .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBS]"":RALBS,1:"Unknown")
- .. Q:'$L(RALBST)  N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
+ .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
  .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBST,1,((80-RALEN)-16))
  .. Q
- . I $D(RAVERFND)&(RAPIS=RAVERF),(RAPIS(200,RAPIS("IENS"),.01)'="RADIOLOGY,OUTSIDE SERVICE") D
+ . I $D(RAVERFND)&(RAPIS=RAVERF) D
  .. I $G(RARPT(10))']"",('$D(RAUTOE)) D  Q
  ... W:RAWHOVER=RAPIS !?10,"(Verifier, no e-sig)"
@@ -62 +45 @@
  . Q
  D SECSTF^RARTR1 Q:$D(RAOOUT)  ; Print secondary interp'ting staff now
- ;now for primary resident definitions...
  I RAPIR D  Q:$D(RAOOUT)
- . ;get signature block name if defined
- . S RALBR=$E(RAPIR(200,RAPIR("IENS"),20.2),1,25)
- . S:RALBR="" RALBR=$E(RAPIR(200,RAPIR("IENS"),.01),1,25) ;default to NAME
- . ;
- . ;get signature block title if defined
- . S RALBRT=$G(RAPIR(200,RAPIR("IENS"),20.3)) ; max: 50 chars
- . S:RALBRT="" RALBRT=$$TITLE^RARTR0(RAPIR)
- . ;
+ . S RALBR=$E($P($G(^VA(200,RAPIR,20)),"^",2),1,25)
+ . S:RALBR']"" RALBR=$E($P($G(VA(200,RAPIR,0)),"^"),1,25)
+ . S RALBRT=$P($G(^VA(200,RAPIR,20)),"^",3) ; max: 50 chars
+ . I RALBRT']"" S RALBRT=$$TITLE^RARTR0(RAPIR)
  . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
  . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
- . I '$D(RAUTOE) D
- .. W !,"Primary Interpreting Resident:",!?2,$S(RALBR]"":RALBR,1:"Unknown")
- .. W:$L(RALBRT) ", "_$E(RALBRT,1,((IOM-$X)-16))
- .. Q
+ . W:'$D(RAUTOE) !,"Primary Interpreting Resident:"
+ . W:'$D(RAUTOE) !?2,$S(RALBR]"":RALBR,1:"Unknown")_", ",$E(RALBRT,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))="Primary Interpreting Resident:"
  .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBR]"":RALBR,1:"Unknown")
- .. Q:'$L(RALBRT)  N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
+ .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
  .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBRT,1,((80-RALEN)-16))
  .. Q
@@ -100 +77 @@
  . Q
  D SECRES^RARTR1 ; Print out secondary interp'ting resident now
- K RAPIR,RAPIS ;P84 kills added
  Q
- ;
-TITLE(X) ;Return the radiology classification in lieu of the signature block title
+TITLE(X) ; Determine an individuals title
  ; 'X' is the IEN of the Primary Interpreting Resident i.e, ^DD(70.03,12
  ; -OR-
  ; 'X' is the IEN of the Primary Interpreting Staff i.e, ^DD(70.03,15
- Q $S($D(^VA(200,"ARC","R",X)):"Resident Physician",$D(^VA(200,"ARC","S",X)):"Staff Physician",1:"")
- ; 
+ N Y
+ I $D(^VA(200,"ARC","R",X)) S Y="Resident Physician" Q Y
+ I $D(^VA(200,"ARC","S",X)) S Y="Staff Physician" Q Y
+ S Y=""
+ Q Y
 HEAD ; Set up header info for e-mail message (called from INIT^RARTR)
  ; 06/28/2006 BAY/KAM Remedy Call 146291 Change Patient Age to DOB