- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTR.m
r613 r623 1 RARTR ;HISC/CAH COLUMBIA/REB AISC/MJK,RMO-Queue/print Reports ;11/27/98 09:05 2 ;;5.0;Radiology/Nuclear Medicine;**5,13,16,27,43,55,75,92**;Mar 16, 1998;Build 4 3 PRT ; Begin print/build of e-mail message 4 ; 5 ; ** NOTE: If the layout of this output is changed ** 6 ; ** please check that routine RAO7PC3 is ** 7 ; ** not affected. It assumes fixed format of ** 8 ; ** the following headings: ** 9 ; ** Clinical History: ** 10 ; ** Report: ** 11 ; ** Impression: ** 12 ; ** Primary Diagnostic Code: ** 13 ; ** Secondary Diagnostic Codes: ** 14 ; ** Primary Interpreting Staff: ** 15 ; 16 Q:'$D(^RARPT(+$G(RARPT),0)) 17 ; Use and Set if running in the foreground and Writing to the device 18 I '$D(RAUTOE) D 19 . U IO 20 . S RAFFLF=IOF 21 . S RAORIOF=RAFFLF 22 ; 23 W:$Y>0&('$D(RAUTOE)) @RAFFLF ; If RAUTOE defined build mail msg 24 S X=$G(^RARPT(+$G(RARPT),0)) ; RAORIOF=RAFFLF 25 ; 26 ;S RAFFLF=$S('$D(ORACTION):RAFFLF,ORACTION'=8:RAFFLF,1:"!") 27 D INIT ; setup exam/report variables 28 I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q ; data nodes missing 29 ; 30 PRT1 I $D(RAUTOE) D 31 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" " 32 . I $D(RADDEN) D 33 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Unverified by: "_$P($G(^VA(200,$S($G(RADUZ):RADUZ,1:DUZ),0)),"^") 34 .. Q 35 . Q 36 I +$O(^RARPT(RARPT,"ERR",0)) D 37 . S RAERRFLG="" ; set for future reference (display AMENRPT^RARTR text) 38 . W:'$D(RAUTOE) !!?10,$$AMENRPT^RARTR2(),! 39 . I $D(RAUTOE) D 40 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" " 41 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$$AMENRPT^RARTR2() 42 .. Q 43 . Q 44 I $P(RAY3,"^",25)<2 D G END:$D(RAOOUT) 45 . D MODS^RAUTL2,OUT1^RARTR3 46 . D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28)) Q:$D(RAOOUT) 47 . D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",") 48 . ;W:'$D(RAUTOE) ! 49 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 50 . Q 51 I $P(RAY3,"^",25)>1 D 52 . D MEMS1^RARTR3 53 . W:'$D(RAUTOE) ! 54 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 55 . Q 56 G END:$D(RAOOUT) 57 ; Check for duplicate history in file 70 and 74. 58 D CHKDUPHX^RART1 ; Sets RADUPHX to 1 for duplicate or 0 if different. 59 F RAP="H","AH","R","I" K ^UTILITY($J,"W"),^(1) D G END:$D(RAOOUT) 60 . S RAP("P")=$S(RAP="H":"Clinical History:",RAP="AH":"Additional Clinical History:",RAP="R":"Report:",1:"Impression:") 61 . ; Don't continue if printing Additional Clinical History and it is a 62 . ; duplicate of Clinical History. 63 . Q:RAP="AH"&(RADUPHX>0) 64 . W:'$D(RAUTOE) !?RATAB,RAP("P") 65 . I $D(RAUTOE),($D(RADDEN)),(RAP="R") D 66 .. N RABAN1,RABAN2,RASPCE S $P(RASPCE," ",46)="" 67 .. S RABAN1="*** Uncorrected Version ***" 68 .. S RABAN2="*** Refer to final report ***" 69 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 70 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN1 71 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN2 72 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 73 .. Q 74 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_RAP("P") 75 . W:$D(RASTFL)&(RAP="R")&('$D(RAUTOE)) ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2)) 76 . I RAP="R",($D(RAUTOE)) D 77 .. S $P(RAP("S")," ",(46-$L(^TMP($J,"RA AUTOE",RAACNT))))="" 78 .. I '$D(RADDEN) S ^TMP($J,"RA AUTOE",RAACNT)=^(RAACNT)_RAP("S")_"Status: "_$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2)) 79 .. Q 80 . D:$D(RAUTOE) SET^RARTR2 81 . D:'$D(RAUTOE) WRITE^RARTR2 Q:$D(RAOOUT) 82 . K ^UTILITY($J,"W") 83 . Q 84 I $D(RADDEN),($G(^RARPT(RARPT,"PURGE"))) D 85 . ; when the report is unverified and purge data exists (rpt adden) 86 . N RAPRGE S RAPRGE=+$G(^RARPT(RARPT,"PURGE")) 87 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 88 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Purged: "_$$FMTE^XLFDT(RAPRGE,"1P") 89 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 90 . Q 91 I $P($G(^RA(79.1,+$P(RAY2,U,4),0)),U,18)="Y" D PRTDX^RARTR1 G:$D(RAOOUT) END ;print dx codes 92 D EN1^RARTR0 G:$D(RAOOUT) END 93 I '$D(RAVERFND) D G END:$D(RAOOUT) 94 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL 95 . N RADFTSBN,RADFTSBT S:$D(RADDEN) RAVERF=+$P(RA74B4,"^",9) 96 . S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25) 97 . S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25) 98 . S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30) 99 . I RADFTSBT']"" S RADFTSBT=$$TITLE^RARTR0(RAVERF) 100 . W:'$D(RAUTOE) !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"") 101 . W:RADFTSBT]""&('$D(RAUTOE)) ", "_RADFTSBT 102 . I $D(RAUTOE) D 103 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="VERIFIED BY:" 104 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RADFTSBN]"":RADFTSBN,1:"")_$S(RADFTSBT]"":", "_RADFTSBT,1:"") 105 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 106 .. Q 107 . Q 108 K RASBPN,RASBT,RASECIEN,RASECOND,RASECSS 109 I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 G END:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL 110 W:'$D(RAUTOE) !!,$S($D(^RABTCH(74.2,+RABTCH,0)):$P(^(0),"^"),1:""),"/" I +$G(^RARPT(RARPT,"T")),$D(^VA(200,+$P(^RARPT(RARPT,"T"),"^"),0)) W:'$D(RAUTOE) $P(^(0),"^",2) 111 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$P($G(^RABTCH(74.2,+RABTCH,0)),"^")_"/"_$S(+$G(^RARPT(RARPT,"T"))&($D(^VA(200,+$P($G(^RARPT(RARPT,"T")),"^"),0))):$P(^(0),"^",2),1:"") 112 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 113 D HANG^RARTR2 G END:$D(RAOOUT) 114 I RAST'="V" D:'$D(RAMDV) SETDIV^RARTR2 I $P(RAMDV,U,25) D WARNING^RARTR1 115 G PEND:RAST'="PD" 116 S $P(RASTRSK,"*",80)="" 117 I '$D(RAUTOE) D 118 . D HD:($Y+RAFOOT+9)>IOSL 119 . W !,$E(RASTRSK,1,22)," P R O B L E M S T A T E M E N T ",$E(RASTRSK,1,22) 120 . W !!,$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") W !!,RASTRSK 121 . Q 122 E D 123 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$E(RASTRSK,1,22)_" P R O B L E M S T A T E M E N T "_$E(RASTRSK,1,22) 124 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") 125 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 126 . Q 127 PEND D FOOT^RARTR2,HANG^RARTR2 D:'$D(RAMIE)&('$D(RAUTOE)) Q^RAFLH1 128 END K:$D(RAOOUT) XQAID,XQAKILL 129 K %I,%W,%Y1,C,DN,I,RADXCODE,RARTMES,RAVERF,RAVERFND,RAPVERF 130 K RAVERS,RAFOOT,RAY0,RAY1,RAY2,RAY3,RALOC,RAFMT,RAMOD,RASTFL,RALB,RALBR 131 K RALBRT,RALBS,RALBST,RAV,RAP,RATAB,RAXX,VAL,VAR,RADFN,RADTI,RACN,RADTE 132 K RARPT,RAHDFM,RAFTFM,RAV,RAIOF,RABTCH,RAOOUT,RAPIR,RAPIS,VAERR,Z 133 ; K RASTRSK S RAFFLF=RAORIOF K RAORIOF,RAFFLF,RAERRFLG 134 ; 05/15/08 BAY/KAM Patch RA*5*92 Added Conditional Kill to next line 135 ; to support an AMIE interface (IA 708) 136 K RASTRSK,RAORIOF,RAFFLF,RAERRFLG K:'($D(RAMIE)#2) DFN 137 ;the next kill line corrects the CPRS V27 report display issue when repeated 138 ;on same patient P92 139 K %,DIW,DIWF,DIWI,DIWL,DIWT,DIWTC,DIWX,RAACNT,RADUPHX,RANUM,RAREZON,RAST 140 Q 141 Q ; Queue the report 142 S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" S:$D(RARTMES) ZTSAVE("RARTMES")="" 143 D ZIS^RAUTL Q:RAPOP 144 ; 145 DQ S U="^",X="T",%DT="" D ^%DT K %DT S DT=Y G PRT 146 ; 147 INIT ; initialize exam/report variables 148 ; main variables set: 149 ; RAY0: zero node data from the Patient File (2) 150 ; RAY1: zero node data from the Rad/Nuc Med Patient File (70) 151 ; RAY2: Registered Exams (70.02) zero node data 152 ; RAY3: Examinations (70.03) zero node data 153 S (RAY0,RAY1,RAY2,RAY3)=-1 ; error condition, if no data nodes 154 S RADFN=+$P(X,"^",2),RADTE=+$P(X,"^",3),RADTI=(9999999.9999-RADTE) 155 S RACN=+$P(X,"^",4),RAST=$P(X,"^",5),RATAB=5 156 S:'$D(RABTCH) RABTCH=0 S (DIWL,DIWF)=0 157 Q:'$D(^RADPT(RADFN,0)) S RANUM=1,RAY1=^(0) 158 Q:'$D(^DPT(RADFN,0)) S RAY0=^(0) 159 Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0) 160 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) 161 S (RAY3,RALB)=$S($D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)):^(0),1:-1) 162 Q:RAY3<0 ; examinations data missing 163 ; 164 S (RAHDFM,RAFTFM)=1 S:$D(^RA(79.1,+$P(RAY2,"^",4),0)) RAHDFM=^(0),RAFTFM=+$P(RAHDFM,"^",13),DIWL=$P(RAHDFM,"^",14),DIWF=$P(RAHDFM,"^",15),RAHDFM=+$P(RAHDFM,"^",12) S RAFOOT=$S($D(^RA(78.2,RAFTFM,0)):+$P(^(0),"^",2),1:0) 165 S:'DIWL DIWL=5 S:'DIWF DIWF=70 S DIWF="WC"_(DIWF-DIWL) 166 G @$S($D(RAUTOE):"HEAD^RARTR0",1:"HD1") 167 Q 168 ; 169 HD D FOOT^RARTR2:$E(IOST,1,2)'="C-" 170 HD1 S RAFMT=RAHDFM I $D(RARTMES) W:$Y>0 @RAFFLF W !,?((80-$L(RARTMES))/2),RARTMES,! S RAIOF=RAFFLF,RAFFLF="!" 171 I '$D(RARTMES) W:$Y>0 @RAFFLF 172 D PRT^RAFLH S:$D(RARTMES) RAFFLF=RAIOF 173 W:$D(RAERRFLG) !!?10,$$AMENRPT^RARTR2(),!! 174 Q 1 RARTR ;HISC/CAH COLUMBIA/REB AISC/MJK,RMO-Queue/print Reports ;11/27/98 09:05 2 ;;5.0;Radiology/Nuclear Medicine;**5,13,16,27,43,55,75**;Mar 16, 1998;Build 4 3 PRT ; Begin print/build of e-mail message 4 ; 5 ; ** NOTE: If the layout of this output is changed ** 6 ; ** please check that routine RAO7PC3 is ** 7 ; ** not affected. It assumes fixed format of ** 8 ; ** the following headings: ** 9 ; ** Clinical History: ** 10 ; ** Report: ** 11 ; ** Impression: ** 12 ; ** Primary Diagnostic Code: ** 13 ; ** Secondary Diagnostic Codes: ** 14 ; ** Primary Interpreting Staff: ** 15 ; 16 Q:'$D(^RARPT(+$G(RARPT),0)) 17 ; Use and Set if running in the foreground and Writing to the device 18 I '$D(RAUTOE) D 19 . U IO 20 . S RAFFLF=IOF 21 . S RAORIOF=RAFFLF 22 ; 23 W:$Y>0&('$D(RAUTOE)) @RAFFLF ; If RAUTOE defined build mail msg 24 S X=$G(^RARPT(+$G(RARPT),0)) ; RAORIOF=RAFFLF 25 ; 26 ;S RAFFLF=$S('$D(ORACTION):RAFFLF,ORACTION'=8:RAFFLF,1:"!") 27 D INIT ; setup exam/report variables 28 I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q ; data nodes missing 29 ; 30 PRT1 I $D(RAUTOE) D 31 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" " 32 . I $D(RADDEN) D 33 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Unverified by: "_$P($G(^VA(200,$S($G(RADUZ):RADUZ,1:DUZ),0)),"^") 34 .. Q 35 . Q 36 I +$O(^RARPT(RARPT,"ERR",0)) D 37 . S RAERRFLG="" ; set for future reference (display AMENRPT^RARTR text) 38 . W:'$D(RAUTOE) !!?10,$$AMENRPT^RARTR2(),! 39 . I $D(RAUTOE) D 40 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" " 41 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$$AMENRPT^RARTR2() 42 .. Q 43 . Q 44 I $P(RAY3,"^",25)<2 D G END:$D(RAOOUT) 45 . D MODS^RAUTL2,OUT1^RARTR3 46 . D:+$P(RAY3,"^",28) RDIO^RARTUTL(+$P(RAY3,"^",28)) Q:$D(RAOOUT) 47 . D:+$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) PHARM^RARTUTL(RACNI_","_RADTI_","_RADFN_",") 48 . ;W:'$D(RAUTOE) ! 49 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 50 . Q 51 I $P(RAY3,"^",25)>1 D 52 . D MEMS1^RARTR3 53 . W:'$D(RAUTOE) ! 54 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 55 . Q 56 G END:$D(RAOOUT) 57 ; Check for duplicate history in file 70 and 74. 58 D CHKDUPHX^RART1 ; Sets RADUPHX to 1 for duplicate or 0 if different. 59 F RAP="H","AH","R","I" K ^UTILITY($J,"W"),^(1) D G END:$D(RAOOUT) 60 . S RAP("P")=$S(RAP="H":"Clinical History:",RAP="AH":"Additional Clinical History:",RAP="R":"Report:",1:"Impression:") 61 . ; Don't continue if printing Additional Clinical History and it is a 62 . ; duplicate of Clinical History. 63 . Q:RAP="AH"&(RADUPHX>0) 64 . W:'$D(RAUTOE) !?RATAB,RAP("P") 65 . I $D(RAUTOE),($D(RADDEN)),(RAP="R") D 66 .. N RABAN1,RABAN2,RASPCE S $P(RASPCE," ",46)="" 67 .. S RABAN1="*** Uncorrected Version ***" 68 .. S RABAN2="*** Refer to final report ***" 69 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 70 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN1 71 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=RASPCE_RABAN2 72 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 73 .. Q 74 . S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_RAP("P") 75 . W:$D(RASTFL)&(RAP="R")&('$D(RAUTOE)) ?45,"Status: ",$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2)) 76 . I RAP="R",($D(RAUTOE)) D 77 .. S $P(RAP("S")," ",(46-$L(^TMP($J,"RA AUTOE",RAACNT))))="" 78 .. I '$D(RADDEN) S ^TMP($J,"RA AUTOE",RAACNT)=^(RAACNT)_RAP("S")_"Status: "_$$XTERNAL^RAUTL5(RAST,$P($G(^DD(74,5,0)),"^",2)) 79 .. Q 80 . D:$D(RAUTOE) SET^RARTR2 81 . D:'$D(RAUTOE) WRITE^RARTR2 Q:$D(RAOOUT) 82 . K ^UTILITY($J,"W") 83 . Q 84 I $D(RADDEN),($G(^RARPT(RARPT,"PURGE"))) D 85 . ; when the report is unverified and purge data exists (rpt adden) 86 . N RAPRGE S RAPRGE=+$G(^RARPT(RARPT,"PURGE")) 87 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 88 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="Report Purged: "_$$FMTE^XLFDT(RAPRGE,"1P") 89 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 90 . Q 91 I $P($G(^RA(79.1,+$P(RAY2,U,4),0)),U,18)="Y" D PRTDX^RARTR1 G:$D(RAOOUT) END ;print dx codes 92 D EN1^RARTR0 G:$D(RAOOUT) END 93 I '$D(RAVERFND) D G END:$D(RAOOUT) 94 . I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 Q:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL 95 . N RADFTSBN,RADFTSBT S:$D(RADDEN) RAVERF=+$P(RA74B4,"^",9) 96 . S RADFTSBN=$E($P($G(^VA(200,RAVERF,20)),"^",2),1,25) 97 . S:RADFTSBN']"" RADFTSBN=$E($P($G(^VA(200,RAVERF,0)),"^"),1,25) 98 . S RADFTSBT=$E($P($G(^VA(200,RAVERF,20)),"^",3),1,30) 99 . I RADFTSBT']"" S RADFTSBT=$$TITLE^RARTR0(RAVERF) 100 . W:'$D(RAUTOE) !!,"VERIFIED BY:",!?2,$S(RADFTSBN]"":RADFTSBN,1:"") 101 . W:RADFTSBT]""&('$D(RAUTOE)) ", "_RADFTSBT 102 . I $D(RAUTOE) D 103 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="VERIFIED BY:" 104 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=" "_$S(RADFTSBN]"":RADFTSBN,1:"")_$S(RADFTSBT]"":", "_RADFTSBT,1:"") 105 .. S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 106 .. Q 107 . Q 108 K RASBPN,RASBT,RASECIEN,RASECOND,RASECSS 109 I '$D(RAUTOE) D:($Y+RAFOOT+4)>IOSL HANG^RARTR2 G END:$D(RAOOUT) D HD:($Y+RAFOOT+4)>IOSL 110 W:'$D(RAUTOE) !!,$S($D(^RABTCH(74.2,+RABTCH,0)):$P(^(0),"^"),1:""),"/" I +$G(^RARPT(RARPT,"T")),$D(^VA(200,+$P(^RARPT(RARPT,"T"),"^"),0)) W:'$D(RAUTOE) $P(^(0),"^",2) 111 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$P($G(^RABTCH(74.2,+RABTCH,0)),"^")_"/"_$S(+$G(^RARPT(RARPT,"T"))&($D(^VA(200,+$P($G(^RARPT(RARPT,"T")),"^"),0))):$P(^(0),"^",2),1:"") 112 S:$D(RAUTOE) ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 113 D HANG^RARTR2 G END:$D(RAOOUT) 114 I RAST'="V" D:'$D(RAMDV) SETDIV^RARTR2 I $P(RAMDV,U,25) D WARNING^RARTR1 115 G PEND:RAST'="PD" 116 S $P(RASTRSK,"*",80)="" 117 I '$D(RAUTOE) D 118 . D HD:($Y+RAFOOT+9)>IOSL 119 . W !,$E(RASTRSK,1,22)," P R O B L E M S T A T E M E N T ",$E(RASTRSK,1,22) 120 . W !!,$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") W !!,RASTRSK 121 . Q 122 E D 123 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$E(RASTRSK,1,22)_" P R O B L E M S T A T E M E N T "_$E(RASTRSK,1,22) 124 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))=$S($D(^RARPT(RARPT,"P")):^("P"),1:"None entered.") 125 . S ^TMP($J,"RA AUTOE",$$INCR^RAUTL4(RAACNT))="" 126 . Q 127 PEND D FOOT^RARTR2,HANG^RARTR2 D:'$D(RAMIE)&('$D(RAUTOE)) Q^RAFLH1 128 END K:$D(RAOOUT) XQAID,XQAKILL 129 K %I,%W,%Y1,C,DN,I,RADXCODE,RARTMES,RAVERF,RAVERFND,RAPVERF 130 K RAVERS,RAFOOT,RAY0,RAY1,RAY2,RAY3,RALOC,RAFMT,RAMOD,RASTFL,RALB,RALBR 131 K RALBRT,RALBS,RALBST,RAV,RAP,RATAB,RAXX,VAL,VAR,RADFN,RADTI,RACN,RADTE 132 K RARPT,RAHDFM,RAFTFM,RAV,RAIOF,RABTCH,RAOOUT,RAPIR,RAPIS,VAERR,Z 133 ; K RASTRSK S RAFFLF=RAORIOF K RAORIOF,RAFFLF,RAERRFLG 134 K RASTRSK,RAORIOF,RAFFLF,RAERRFLG 135 Q 136 Q ; Queue the report 137 S ZTDTH=$H,ZTRTN="DQ^RARTR",ZTSAVE("RARPT")="" S:$D(RARTMES) ZTSAVE("RARTMES")="" 138 D ZIS^RAUTL Q:RAPOP 139 ; 140 DQ S U="^",X="T",%DT="" D ^%DT K %DT S DT=Y G PRT 141 ; 142 INIT ; initialize exam/report variables 143 ; main variables set: 144 ; RAY0: zero node data from the Patient File (2) 145 ; RAY1: zero node data from the Rad/Nuc Med Patient File (70) 146 ; RAY2: Registered Exams (70.02) zero node data 147 ; RAY3: Examinations (70.03) zero node data 148 S (RAY0,RAY1,RAY2,RAY3)=-1 ; error condition, if no data nodes 149 S RADFN=+$P(X,"^",2),RADTE=+$P(X,"^",3),RADTI=(9999999.9999-RADTE) 150 S RACN=+$P(X,"^",4),RAST=$P(X,"^",5),RATAB=5 151 S:'$D(RABTCH) RABTCH=0 S (DIWL,DIWF)=0 152 Q:'$D(^RADPT(RADFN,0)) S RANUM=1,RAY1=^(0) 153 Q:'$D(^DPT(RADFN,0)) S RAY0=^(0) 154 Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0) 155 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) 156 S (RAY3,RALB)=$S($D(^RADPT(RADFN,"DT",RADTI,"P",+RACNI,0)):^(0),1:-1) 157 Q:RAY3<0 ; examinations data missing 158 ; 159 S (RAHDFM,RAFTFM)=1 S:$D(^RA(79.1,+$P(RAY2,"^",4),0)) RAHDFM=^(0),RAFTFM=+$P(RAHDFM,"^",13),DIWL=$P(RAHDFM,"^",14),DIWF=$P(RAHDFM,"^",15),RAHDFM=+$P(RAHDFM,"^",12) S RAFOOT=$S($D(^RA(78.2,RAFTFM,0)):+$P(^(0),"^",2),1:0) 160 S:'DIWL DIWL=5 S:'DIWF DIWF=70 S DIWF="WC"_(DIWF-DIWL) 161 G @$S($D(RAUTOE):"HEAD^RARTR0",1:"HD1") 162 Q 163 ; 164 HD D FOOT^RARTR2:$E(IOST,1,2)'="C-" 165 HD1 S RAFMT=RAHDFM I $D(RARTMES) W:$Y>0 @RAFFLF W !,?((80-$L(RARTMES))/2),RARTMES,! S RAIOF=RAFFLF,RAFFLF="!" 166 I '$D(RARTMES) W:$Y>0 @RAFFLF 167 D PRT^RAFLH S:$D(RARTMES) RAFFLF=RAIOF 168 W:$D(RAERRFLG) !!?10,$$AMENRPT^RARTR2(),!! 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
