Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR0.m

    r613 r623  
    1 RARTR0  ;HISC/GJC-Queue/Print Radiology Rpts utility routine. ;1/8/97  08:07
    2         ;;5.0;Radiology/Nuclear Medicine;**8,26,74,84**;Mar 16, 1998;Build 13
    3         ; 06/28/2006 BAY/KAM Remedy Call 146291 - Change Patient Age to DOB
    4         ;
    5         ;Integration Agreements
    6         ;----------------------
    7         ;DT^DILF(2054); GETS^DIQ(2056); $$FMTE^XLFDT(10103); $$UP^XLFSTR(10104)
    8         ;NEW PERSON file read w/FM (10060)
    9         ;
    10 EN1     ; Called from RARTR ;P84 GETS^DIQ added...
    11         S RARPT(0)=$G(^RARPT(+$G(RARPT),0)) Q:RARPT(0)']""
    12         S RARPT(10)=$P(RARPT(0),"^",10)
    13         S RAVERF=+$P(RARPT(0),U,9),RAPVERF=+$P(RARPT(0),U,13)
    14         K RAPIR,RAPIS S RAPIR=+$P(RALB,"^",12),RAPIS=+$P(RALB,"^",15)
    15         ;format of the RAPIR/RAPIS arrays: P84 logic
    16         ;RAPI*=IEN file 200
    17         ;RAPI*(200,RAPI*,.01)= NAME (required)
    18         ;RAPI*(200,RAPI*,20.2) = SIGNATURE BLOCK PRINTED NAME (if any)
    19         ;RAPI*(200,RAPI*,20.3) = SIGNATURE BLOCK TITLE (if any)
    20         I RAPIR D GETS^DIQ(200,RAPIR,".01;20.2;20.3","","RAPIR") S RAPIR("IENS")=RAPIR_","
    21         I RAPIS D GETS^DIQ(200,RAPIS,".01;20.2;20.3","","RAPIS") S RAPIS("IENS")=RAPIS_","
    22         S RAWHOVER=+$P(RARPT(0),"^",17)
    23         I RAVERF,((RAPIR=RAVERF)!(RAPIS=RAVERF)) D
    24         . S RAVERFND="" ; Set verifier found flag
    25         . Q
    26         I RAPIS D  Q:$D(RAOOUT)
    27         . ;get signature block name if defined
    28         . S RALBS=$E(RAPIS(200,RAPIS("IENS"),20.2),1,25)
    29         . S:RALBS="" RALBS=$E(RAPIS(200,RAPIS("IENS"),.01),1,25) ;default to NAME
    30         . ;
    31         . ;get signature block title if defined
    32         . S RALBST=$G(RAPIS(200,RAPIS("IENS"),20.3)) ; max: 50 chars
    33         . S:RALBST="" RALBST=$$TITLE^RARTR0(RAPIS)
    34         . ;
    35         . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
    36         . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
    37         . I '$D(RAUTOE) D
    38         .. W !,"Primary Interpreting Staff:",!?2,$S(RALBS]"":RALBS,1:"Unknown")
    39         .. W:$L(RALBST) ", "_$E(RALBST,1,((IOM-$X)-16))
    40         .. ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
    41         .. Q
    42         . E  D
    43         .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Primary Interpreting Staff:"
    44         .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBS]"":RALBS,1:"Unknown")
    45         .. Q:'$L(RALBST)  N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
    46         .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBST,1,((80-RALEN)-16))
    47         .. Q
    48         . I $D(RAVERFND)&(RAPIS=RAVERF),(RAPIS(200,RAPIS("IENS"),.01)'="RADIOLOGY,OUTSIDE SERVICE") D
    49         .. I $G(RARPT(10))']"",('$D(RAUTOE)) D  Q
    50         ... W:RAWHOVER=RAPIS !?10,"(Verifier, no e-sig)"
    51         ... W:RAWHOVER'=RAPIS !?10,"Verified by transcriptionist for "_RALBS  ;Removed RA*5*8 _", M.D."
    52         ... Q
    53         .. I $G(RARPT(10))']"",($D(RAUTOE)) D  Q
    54         ... S:RAWHOVER=RAPIS ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          (Verifier, no e-sig)"
    55         ... S:RAWHOVER'=RAPIS ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          Verified by transcriptionist for "_RALBS  ;Removed RA*5*8 _", M.D."
    56         ... Q
    57         .. W:'$D(RAUTOE) " (Verifier)"
    58         .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
    59         .. Q
    60         . I RAPIS=RAPVERF,'$D(RAUTOE) W " (Pre-Verifier)"
    61         . I RAPIS=RAPVERF,$D(RAUTOE) S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
    62         . Q
    63         D SECSTF^RARTR1 Q:$D(RAOOUT)  ; Print secondary interp'ting staff now
    64         ;now for primary resident definitions...
    65         I RAPIR D  Q:$D(RAOOUT)
    66         . ;get signature block name if defined
    67         . S RALBR=$E(RAPIR(200,RAPIR("IENS"),20.2),1,25)
    68         . S:RALBR="" RALBR=$E(RAPIR(200,RAPIR("IENS"),.01),1,25) ;default to NAME
    69         . ;
    70         . ;get signature block title if defined
    71         . S RALBRT=$G(RAPIR(200,RAPIR("IENS"),20.3)) ; max: 50 chars
    72         . S:RALBRT="" RALBRT=$$TITLE^RARTR0(RAPIR)
    73         . ;
    74         . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
    75         . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
    76         . I '$D(RAUTOE) D
    77         .. W !,"Primary Interpreting Resident:",!?2,$S(RALBR]"":RALBR,1:"Unknown")
    78         .. W:$L(RALBRT) ", "_$E(RALBRT,1,((IOM-$X)-16))
    79         .. Q
    80         . I $D(RAUTOE) D
    81         .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Primary Interpreting Resident:"
    82         .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBR]"":RALBR,1:"Unknown")
    83         .. Q:'$L(RALBRT)  N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
    84         .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBRT,1,((80-RALEN)-16))
    85         .. Q
    86         . I $D(RAVERFND)&(RAPIR=RAVERF) D
    87         .. I $G(RARPT(10))']"",('$D(RAUTOE)) D  Q
    88         ... W:RAWHOVER=RAPIR !?10,"(Verifier, no e-sig)"
    89         ... W:RAWHOVER'=RAPIR !?10,"Verified by transcriptionist for "_RALBR  ;Removed RA*5*8 _", M.D."
    90         ... Q
    91         .. I $G(RARPT(10))']"",($D(RAUTOE)) D  Q
    92         ... S:RAWHOVER=RAPIR ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          (Verifier, no e-sig)"
    93         ... S:RAWHOVER'=RAPIR ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          Verified by transcriptionist for "_RALBR  ;Removed RA*5*8 _", M.D."
    94         ... Q
    95         .. W:'$D(RAUTOE) " (Verifier)"
    96         .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
    97         .. Q
    98         . I RAPIR=RAPVERF,('$D(RAUTOE)) W " (Pre-Verifier)"
    99         . I RAPIR=RAPVERF,($D(RAUTOE)) S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
    100         . Q
    101         D SECRES^RARTR1 ; Print out secondary interp'ting resident now
    102         K RAPIR,RAPIS ;P84 kills added
    103         Q
    104         ;
    105 TITLE(X)        ;Return the radiology classification in lieu of the signature block title
    106         ; 'X' is the IEN of the Primary Interpreting Resident i.e, ^DD(70.03,12
    107         ; -OR-
    108         ; 'X' is the IEN of the Primary Interpreting Staff i.e, ^DD(70.03,15
    109         Q $S($D(^VA(200,"ARC","R",X)):"Resident Physician",$D(^VA(200,"ARC","S",X)):"Staff Physician",1:"")
    110         ;
    111 HEAD    ; Set up header info for e-mail message (called from INIT^RARTR)
    112         ; 06/28/2006 BAY/KAM Remedy Call 146291 Change Patient Age to DOB
    113         N RAGE,RATPHY,RACSE,RAILOC,RANME,RAPRIPHY,RAPTLOC,RAREQPHY,RASERV,RASEX,RADOB
    114         N RASPACE,RASSN,X1,X2 S:'$D(RAACNT) RAACNT=0
    115         ;Added next line for Remedy Call 146291
    116         D DT^DILF("E",$P(RAY0,"^",3),.RADOB) ;Get Date of Birth/External Fmt
    117         ;
    118         S RANME=$P(RAY0,"^"),RASSN=$P(RAY0,"^",9)
    119         S RASEX=$$UP^XLFSTR($P(RAY0,"^",2))
    120         S RACSE=$P($G(^RARPT(RARPT,0)),"^")_"@"_$P($$FMTE^XLFDT($P(RAY2,"^")),"@",2)
    121         ; Remedy Call 146291 Removed line calculating age
    122         S RAREQPHY=$$XTERNAL^RAUTL5($P(RAY3,"^",14),$P($G(^DD(70.03,14,0)),"^",2))
    123         S RAPTLOC=$$PTLOC^RAUTL12() S:RAREQPHY']"" RAREQPHY="Unknown"
    124         S RASERV=$$XTERNAL^RAUTL5($P(RAY3,"^",7),$P($G(^DD(70.03,7,0)),"^",2))
    125         S RATPHY=$$ATND^RAUTL5(RADFN,DT),RAPRIPHY=$$PRIM^RAUTL5(RADFN,DT)
    126         S RAILOC=$$XTERNAL^RAUTL5($P(RAY2,"^",4),$P($G(^DD(70.02,4,0)),"^",2))
    127         S:RAILOC']"" RAILOC="Unknown" S:RASERV']"" RASERV="Unknown"
    128         S RANME=$E(RANME,1,20)_"  "
    129         S RASSN=$E(RASSN,1,3)_"-"_$E(RASSN,4,5)_"-"_$E(RASSN,6,9)_"    "
    130         ; Remedy Call 146291 Changed next line to use RADOB(0)
    131         S RAGE="DOB-"_RADOB(0)_" "_$S(RASEX="F":"F",RASEX="M":"M",1:"UNK")
    132         S $P(RASPACE," ",(22-$L(RAGE)))=""
    133         S RAGE=RAGE_RASPACE,RACSE="Case: "_RACSE
    134         S RAREQPHY="Req Phys: "_$E(RAREQPHY,1,28)
    135         S RASPACE="",$P(RASPACE," ",(42-$L(RAREQPHY)))=""
    136         S RAREQPHY=RAREQPHY_RASPACE
    137         S RAPTLOC="Pat Loc: "_$S(RAPTLOC]"":$E(RAPTLOC,1,30),1:"Unknown")
    138         S RATPHY="Att Phys: "_$E(RATPHY,1,28)
    139         S RASPACE="",$P(RASPACE," ",(42-$L(RATPHY)))=""
    140         S RATPHY=RATPHY_RASPACE
    141         S RAILOC="Img Loc: "_$E(RAILOC,1,30)
    142         S RAPRIPHY="Pri Phys: "_$E(RAPRIPHY,1,28)
    143         S RASPACE="",$P(RASPACE," ",(42-$L(RAPRIPHY)))=""
    144         S RAPRIPHY=RAPRIPHY_RASPACE
    145         S RASERV="Service: "_$E(RASERV,1,30)
    146         S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RANME_RASSN_RAGE_RACSE
    147         S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAREQPHY_RAPTLOC
    148         S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATPHY_RAILOC
    149         S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAPRIPHY_RASERV
    150         S:$D(RAERRFLG) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="         "_$$AMENRPT^RARTR2()
    151         S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
    152         Q
     1RARTR0 ;HISC/GJC-Queue/Print Radiology Rpts utility routine. ;1/8/97  08:07
     2 ;;5.0;Radiology/Nuclear Medicine;**8,26,74**;Mar 16, 1998;Build 2
     3 ; 06/28/2006 BAY/KAM Remedy Call 146291 - Change Patient Age to DOB
     4EN1 ; Called from RARTR
     5 S RARPT(0)=$G(^RARPT(+$G(RARPT),0)) Q:RARPT(0)']""
     6 S RARPT(10)=$P(RARPT(0),"^",10)
     7 S RAVERF=+$P(RARPT(0),U,9),RAPVERF=+$P(RARPT(0),U,13)
     8 S RAPIR=+$P(RALB,"^",12),RAPIS=+$P(RALB,"^",15)
     9 S RAWHOVER=+$P(RARPT(0),"^",17)
     10 I RAVERF,((RAPIR=RAVERF)!(RAPIS=RAVERF)) D
     11 . S RAVERFND="" ; Set verifier found flag
     12 . Q
     13 I RAPIS D  Q:$D(RAOOUT)
     14 . S RALBS=$E($P($G(^VA(200,RAPIS,20)),"^",2),1,25)
     15 . S:RALBS']"" RALBS=$E($P($G(VA(200,RAPIS,0)),"^"),1,25)
     16 . S RALBST=$P($G(^VA(200,RAPIS,20)),"^",3) ; max: 50 chars
     17 . I RALBST']"" S RALBST=$$TITLE^RARTR0(RAPIS)
     18 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
     19 . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
     20 . I '$D(RAUTOE) D
     21 .. W !,"Primary Interpreting Staff:"
     22 .. W !?2,$S(RALBS]"":RALBS,1:"Unknown"),", ",$E(RALBST,1,((IOM-$X)-16))
     23 .. ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
     24 .. Q
     25 . E  D
     26 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Primary Interpreting Staff:"
     27 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBS]"":RALBS,1:"Unknown")
     28 .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
     29 .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBST,1,((80-RALEN)-16))
     30 .. Q
     31 . I $D(RAVERFND)&(RAPIS=RAVERF) D
     32 .. I $G(RARPT(10))']"",('$D(RAUTOE)) D  Q
     33 ... W:RAWHOVER=RAPIS !?10,"(Verifier, no e-sig)"
     34 ... W:RAWHOVER'=RAPIS !?10,"Verified by transcriptionist for "_RALBS  ;Removed RA*5*8 _", M.D."
     35 ... Q
     36 .. I $G(RARPT(10))']"",($D(RAUTOE)) D  Q
     37 ... S:RAWHOVER=RAPIS ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          (Verifier, no e-sig)"
     38 ... S:RAWHOVER'=RAPIS ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          Verified by transcriptionist for "_RALBS  ;Removed RA*5*8 _", M.D."
     39 ... Q
     40 .. W:'$D(RAUTOE) " (Verifier)"
     41 .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
     42 .. Q
     43 . I RAPIS=RAPVERF,'$D(RAUTOE) W " (Pre-Verifier)"
     44 . I RAPIS=RAPVERF,$D(RAUTOE) S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
     45 . Q
     46 D SECSTF^RARTR1 Q:$D(RAOOUT)  ; Print secondary interp'ting staff now
     47 I RAPIR D  Q:$D(RAOOUT)
     48 . S RALBR=$E($P($G(^VA(200,RAPIR,20)),"^",2),1,25)
     49 . S:RALBR']"" RALBR=$E($P($G(VA(200,RAPIR,0)),"^"),1,25)
     50 . S RALBRT=$P($G(^VA(200,RAPIR,20)),"^",3) ; max: 50 chars
     51 . I RALBRT']"" S RALBRT=$$TITLE^RARTR0(RAPIR)
     52 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT)
     53 . I '$D(RAUTOE) D HD^RARTR:($Y+RAFOOT+4)>IOSL
     54 . W:'$D(RAUTOE) !,"Primary Interpreting Resident:"
     55 . W:'$D(RAUTOE) !?2,$S(RALBR]"":RALBR,1:"Unknown")_", ",$E(RALBRT,1,((IOM-$X)-16))
     56 . ; The '-16' above is derived from $L("(Pre-Verifier)")+1 FORMATTING
     57 . I $D(RAUTOE) D
     58 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Primary Interpreting Resident:"
     59 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="  "_$S(RALBR]"":RALBR,1:"Unknown")
     60 .. N RALEN S RALEN=$L(^TMP($J,"RA AUTOE",RAACNT))
     61 .. S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_", "_$E(RALBRT,1,((80-RALEN)-16))
     62 .. Q
     63 . I $D(RAVERFND)&(RAPIR=RAVERF) D
     64 .. I $G(RARPT(10))']"",('$D(RAUTOE)) D  Q
     65 ... W:RAWHOVER=RAPIR !?10,"(Verifier, no e-sig)"
     66 ... W:RAWHOVER'=RAPIR !?10,"Verified by transcriptionist for "_RALBR  ;Removed RA*5*8 _", M.D."
     67 ... Q
     68 .. I $G(RARPT(10))']"",($D(RAUTOE)) D  Q
     69 ... S:RAWHOVER=RAPIR ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          (Verifier, no e-sig)"
     70 ... S:RAWHOVER'=RAPIR ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="          Verified by transcriptionist for "_RALBR  ;Removed RA*5*8 _", M.D."
     71 ... Q
     72 .. W:'$D(RAUTOE) " (Verifier)"
     73 .. S:$D(RAUTOE) ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Verifier)"
     74 .. Q
     75 . I RAPIR=RAPVERF,('$D(RAUTOE)) W " (Pre-Verifier)"
     76 . I RAPIR=RAPVERF,($D(RAUTOE)) S ^TMP($J,"RA AUTOE",RAACNT)=^TMP($J,"RA AUTOE",RAACNT)_" (Pre-Verifier)"
     77 . Q
     78 D SECRES^RARTR1 ; Print out secondary interp'ting resident now
     79 Q
     80TITLE(X) ; Determine an individuals title
     81 ; 'X' is the IEN of the Primary Interpreting Resident i.e, ^DD(70.03,12
     82 ; -OR-
     83 ; 'X' is the IEN of the Primary Interpreting Staff i.e, ^DD(70.03,15
     84 N Y
     85 I $D(^VA(200,"ARC","R",X)) S Y="Resident Physician" Q Y
     86 I $D(^VA(200,"ARC","S",X)) S Y="Staff Physician" Q Y
     87 S Y=""
     88 Q Y
     89HEAD ; Set up header info for e-mail message (called from INIT^RARTR)
     90 ; 06/28/2006 BAY/KAM Remedy Call 146291 Change Patient Age to DOB
     91 N RAGE,RATPHY,RACSE,RAILOC,RANME,RAPRIPHY,RAPTLOC,RAREQPHY,RASERV,RASEX,RADOB
     92 N RASPACE,RASSN,X1,X2 S:'$D(RAACNT) RAACNT=0
     93 ;Added next line for Remedy Call 146291
     94 D DT^DILF("E",$P(RAY0,"^",3),.RADOB) ;Get Date of Birth/External Fmt
     95 ;
     96 S RANME=$P(RAY0,"^"),RASSN=$P(RAY0,"^",9)
     97 S RASEX=$$UP^XLFSTR($P(RAY0,"^",2))
     98 S RACSE=$P($G(^RARPT(RARPT,0)),"^")_"@"_$P($$FMTE^XLFDT($P(RAY2,"^")),"@",2)
     99 ; Remedy Call 146291 Removed line calculating age
     100 S RAREQPHY=$$XTERNAL^RAUTL5($P(RAY3,"^",14),$P($G(^DD(70.03,14,0)),"^",2))
     101 S RAPTLOC=$$PTLOC^RAUTL12() S:RAREQPHY']"" RAREQPHY="Unknown"
     102 S RASERV=$$XTERNAL^RAUTL5($P(RAY3,"^",7),$P($G(^DD(70.03,7,0)),"^",2))
     103 S RATPHY=$$ATND^RAUTL5(RADFN,DT),RAPRIPHY=$$PRIM^RAUTL5(RADFN,DT)
     104 S RAILOC=$$XTERNAL^RAUTL5($P(RAY2,"^",4),$P($G(^DD(70.02,4,0)),"^",2))
     105 S:RAILOC']"" RAILOC="Unknown" S:RASERV']"" RASERV="Unknown"
     106 S RANME=$E(RANME,1,20)_"  "
     107 S RASSN=$E(RASSN,1,3)_"-"_$E(RASSN,4,5)_"-"_$E(RASSN,6,9)_"    "
     108 ; Remedy Call 146291 Changed next line to use RADOB(0)
     109 S RAGE="DOB-"_RADOB(0)_" "_$S(RASEX="F":"F",RASEX="M":"M",1:"UNK")
     110 S $P(RASPACE," ",(22-$L(RAGE)))=""
     111 S RAGE=RAGE_RASPACE,RACSE="Case: "_RACSE
     112 S RAREQPHY="Req Phys: "_$E(RAREQPHY,1,28)
     113 S RASPACE="",$P(RASPACE," ",(42-$L(RAREQPHY)))=""
     114 S RAREQPHY=RAREQPHY_RASPACE
     115 S RAPTLOC="Pat Loc: "_$S(RAPTLOC]"":$E(RAPTLOC,1,30),1:"Unknown")
     116 S RATPHY="Att Phys: "_$E(RATPHY,1,28)
     117 S RASPACE="",$P(RASPACE," ",(42-$L(RATPHY)))=""
     118 S RATPHY=RATPHY_RASPACE
     119 S RAILOC="Img Loc: "_$E(RAILOC,1,30)
     120 S RAPRIPHY="Pri Phys: "_$E(RAPRIPHY,1,28)
     121 S RASPACE="",$P(RASPACE," ",(42-$L(RAPRIPHY)))=""
     122 S RAPRIPHY=RAPRIPHY_RASPACE
     123 S RASERV="Service: "_$E(RASERV,1,30)
     124 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RANME_RASSN_RAGE_RACSE
     125 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAREQPHY_RAPTLOC
     126 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RATPHY_RAILOC
     127 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RAPRIPHY_RASERV
     128 S:$D(RAERRFLG) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="         "_$$AMENRPT^RARTR2()
     129 S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=""
     130 Q
Note: See TracChangeset for help on using the changeset viewer.