- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7PC1A.m
r613 r623 1 RAO7PC1A ;HISC/GJC-Procedure Call utilities (cont) ;1/22/03 12:41 2 ;;5.0;Radiology/Nuclear Medicine;**1,10,26,31,36,45,56**;Mar 16, 1998;Build 3 3 ;Supported IA #10040 ^SC( 4 ;Supported IA #10103 DT^XLFDT, FMADD^XLFDT 5 ;Supported IA #2056 GET1^DIQ 6 ;Supported IA #10104 LOW^XLFSTR, UP^XLFSTR 7 SETDATA ; Called from within the EN1 subroutine of RAO7PC1 8 ; Sets the ^TMP($J,"RAE1",patient ien,Exam ID) node. 9 ; See EN1^RAO7PC1 for further explanation. 10 ; 11 ; Output (new) : 12 ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",1)=cptmod^cptmodname 13 ; ,2)=cptmod^cptmodname 14 N RA,RA1,RA2,RA3 15 S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) 16 S RAITY=+$P(RAREX(0),"^",2),RAILOC=+$P(RAREX(0),"^",4) 17 S RAILOC=$P($G(^SC(+$P($G(^RA(79.1,RAILOC,0)),"^"),0)),"^") 18 S RAITY(0)=$G(^RA(79.2,RAITY,0)) 19 F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D Q:RAXIT 20 . S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) 21 . Q:RAXAM(0)="" 22 . S RAORDER=+$P(RAXAM(0),"^",11) 23 . ; quit if exam is WAITING and its order status isn't ACTIVE 24 . ; because this means exam hasn't finished being registered 25 . I $P($G(^RA(72,+$P(RAXAM(0),U,3),0)),U,3)=1,$P($G(^RAO(75.1,RAORDER,0)),U,5)'=6 Q 26 . S RAORDER(7)=$P($G(^RAO(75.1,RAORDER,0)),"^",7) ; CPRS order ien 27 . S RAXSTAT=+$P(RAXAM(0),"^",3),RAXSTAT(0)=$G(^RA(72,RAXSTAT,0)) 28 . S RAXID=RAIBDT_"-"_RANO 29 . S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") 30 . S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) 31 . S RACPT=+$P(RAPRC,"^",9) ; pntr to 81 32 . S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT) 33 . S RACPT=$S($P(RACPT,"^",2)]"":$P(RACPT,"^"),1:"") 34 . S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") 35 . ; quit if cancelled exam, and cancelled exams not requested 36 . I ('$G(RACINC)),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) Q 37 . S RADIAG=+$P(RAXAM(0),U,13),RARPT=+$P(RAXAM(0),U,17) 38 .; E3R 17541, 15507 39 .; if want cancel'd cases returned, and this case is cancelled, then 40 .; also require div param ALLOW RPTS ON CANCELLED CASES? = Y and 41 .; presence of report, else skip this case 42 . I $G(RACINC),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) D Q:RASHOCAN=0 43 .. S RASHOCAN=0 44 .. I $P($G(^RA(79,+$P(RAREX(0),"^",3),.1)),"^",22)="Y",RARPT S RASHOCAN=1 45 .. Q 46 . S RABNOR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,4)) 47 . S:RABNOR'="Y" RABNOR="" 48 . S RABNORMR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,3)) 49 . S:RABNORMR'="Y" RABNORMR="" 50 . S RARPTST=$$RSTAT(),RARPTST=$$UL(RARPTST) 51 . S ^TMP($J,"RAE1",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_RABNOR_U_$S(RARPT=0:"",1:RARPT)_U_$P(RAXSTAT(0),"^",3)_"~"_$P(RAXSTAT(0),"^")_U_RAILOC_U_$P(RAITY(0),"^",3)_"~"_$P(RAITY(0),"^")_U_RABNORMR_U_RACPT_U_$G(RAORDER(7)) 52 . S ^TMP($J,"RAE1",RADFN,RAXID)=^TMP($J,"RAE1",RADFN,RAXID)_U_$S($O(^RARPT(RARPT,2005,0)):"Y",1:"N") 53 . D CPTMOD 54 . S RACNT=RACNT+1 55 .; 56 .; Condensed Radiology Display in CPRS GUI: 57 .; subtract from count if counting parent; count only 1 case from printset 58 .; and 59 .; store values of MEMBER OF SET and ordered parent procedure name 60 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P" D 61 .. I $P(RAXAM(0),U,25)="2",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO),-1) S RACNT=RACNT-1 62 .. I $P(RAXAM(0),U,25) D 63 ... S RA3=$S('RAORDER:"",1:$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAORDER,0)),U,2),0)),U)) 64 ... S RA3=$S(RA3'="":RA3,1:"PARENT PROCEDURE") 65 ... S ^TMP($J,"RAE1",RADFN,RAXID,"CPRS")=$P(RAXAM(0),U,25)_U_RA3 66 ... Q 67 .. Q 68 . S:RACNT=RAEXN RAXIT=1 69 .; Condensed Radiology Display in CPRS GUI: 70 .; do not exit until all cases of printset have been stored 71 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) S RAXIT=0 72 . K RAXSTAT,RAORDER 73 . Q 74 K RAILOC,RAITY 75 Q 76 CASE ; Return the case numbers and the total number of case numbers 77 ; associated with a particular order. Called from CASE^RAO7PC1. 78 ; Sets RARRAY(case #)="" for all cases associated with an order. 79 ; Sets first piece of RATTL to the number of cases found for an 80 ; order, and the second piece is PRINTSET if the report covers 81 ; multiple cases. See CASE^RAO7PC1 for more information. 82 I '$D(^RAO(75.1,RAOIFN,0))#2 S RATTL="-1^invalid order ien" Q 83 I '$D(^RADPT("AO",RAOIFN)) D Q ; case has yet to be registered 84 . S RATTL="-2^no case registered to date" 85 . Q 86 N RACNI,RADFN,RADTI,RAEXAM S RADFN=0 87 F S RADFN=$O(^RADPT("AO",RAOIFN,RADFN)) Q:RADFN'>0 D 88 . S RADTI=0 89 . F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D 90 .. S RACNI=0 91 .. F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D 92 ... S RAEXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 93 ... Q:$P($G(^RA(72,+$P(RAEXAM,"^",3),0)),"^",3)=0 ; xam cancelled 94 ... S RATTL=+$G(RATTL)+1,@(RARRAY_"("_+RAEXAM_")")="" 95 ... Q 96 .. Q 97 . Q 98 I 'RATTL S RATTL="-2^cases cancelled" Q 99 S:$P(RAEXAM,"^",25)=2 RATTL=RATTL_"^PRINTSET" ; combined reports 100 Q 101 ; 102 EN2 ; IA: 2012, Return last 7 days of non-cancelled exams 103 ; Required: RADFN (valid patient ien) called from EN2^RAO7PC1 104 ; Output: 105 ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^ 106 ; report status^imaging location IEN^imaging location name^ 107 ; contrast medium or media used 108 ; Note: Single characters in parenthesis indicate contrast 109 ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic; 110 ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin; 111 ; (B)=Barium; (M)=unspecified contrast media 112 ; 113 ; Exam ID: exam date/time (inverse) concatenated with the case IEN 114 ; 115 Q:'$D(RADFN) Q:'RADFN K ^TMP($J,"RAE7") 116 N I,RABDT,RACNST,RACSE,RADT,RAEDT,RAIBDT,RAIEDT,RALOC,RACMEDIA,RANO 117 N RAPRC,RAREX,RARPT,RARPTST,RAXAM,RAXID,RAXSTAT 118 S RADT=$S($D(DT)#2:DT,1:$$DT^XLFDT()),RACNST=9999999.9999 119 S RABDT=$$FMADD^XLFDT(RADT,-7,0,0,0),RAEDT=RADT 120 S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001) 121 F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D 122 . S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) 123 . S RALOC=+$P(RAREX(0),U,4),RALOC(0)=$G(^RA(79.1,RALOC,0)) 124 . S RALOC=$P($G(^SC(+RALOC(0),0)),"^") 125 . F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D 126 .. S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) 127 .. S RAXID=RAIBDT_"-"_RANO 128 .. S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") 129 .. S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) 130 .. S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") 131 .. Q:$P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0 ; cancelled xam 132 .. S I=0,RACMEDIA="" F S I=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CM",I)) Q:'I S RACMEDIA=RACMEDIA_$P(^(I,0),U) ;RA*5*45 133 .. S RARPT=+$P(RAXAM(0),U,17) 134 .. S RARPTST=$$RSTAT(),RARPTST=$$UL(RARPTST) 135 .. S ^TMP($J,"RAE7",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_+RALOC(0)_U_RALOC_U_RACMEDIA 136 .. Q 137 . Q 138 Q 139 CPTMOD ;extract cpt modifiers if any 140 ;RA loop var, RA1 counter, RA2 intermed vars 141 Q:'$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",0)) 142 S RA=0,RA1=1 143 F S RA=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA)) Q:'RA I $D(^(RA,0)) D 144 . S RA2=$P(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA,0),"^") 145 . S RA2=$$BASICMOD^RACPTMSC(RA2,+RAREX(0)) Q:+RA2<0 146 . S ^TMP($J,"RAE1",RADFN,RAXID,"CMOD",RA1)=$P(RA2,"^",2)_"^"_$P(RA2,"^",3),RA1=RA1+1 147 Q 148 RSTAT() ; Get report status name from GET1^DIQ 149 ; RARPT is IEN of file 74 150 N R,DIERR 151 S R=$S($G(RARPT)>0:$$GET1^DIQ(74,+RARPT,5),1:"") 152 S:R="" R="NO REPORT" 153 Q R 154 UL(R) ;Upper and Lower case 155 ;First convert all chars to lower case, then 156 ;capitalize 1st char AND (char after / OR char after blank) 157 N L,R2 158 S R2=$E(R,1)_$$LOW^XLFSTR($E(R,2,$L(R))) ; 1st char must be in caps 159 S L=$F(R2,"/") ; If str has /, cap char after / but not char after blank 160 I L S R2=$E(R2,1,L-1)_$$UP^XLFSTR($E(R2,L))_$E(R2,L+1,$L(R2)) G UPQ 161 S L=$F(R2," ") ; If str has one blank, then cap the char after the blank 162 I L S R2=$E(R2,1,L-1)_$$UP^XLFSTR($E(R2,L))_$E(R2,L+1,$L(R2)) 163 UPQ Q R2 1 RAO7PC1A ;HISC/GJC-Procedure Call utilities (cont) ;1/22/03 12:41 2 ;;5.0;Radiology/Nuclear Medicine;**1,10,26,31,36,45**;Mar 16, 1998 3 SETDATA ; Called from within the EN1 subroutine of RAO7PC1 4 ; Sets the ^TMP($J,"RAE1",patient ien,Exam ID) node. 5 ; See EN1^RAO7PC1 for further explanation. 6 ; 7 ; Output (new) : 8 ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",1)=cptmod^cptmodname 9 ; ,2)=cptmod^cptmodname 10 N RA,RA1,RA2,RA3 11 S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) 12 S RAITY=+$P(RAREX(0),"^",2),RAILOC=+$P(RAREX(0),"^",4) 13 S RAILOC=$P($G(^SC(+$P($G(^RA(79.1,RAILOC,0)),"^"),0)),"^") 14 S RAITY(0)=$G(^RA(79.2,RAITY,0)) 15 F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D Q:RAXIT 16 . S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) 17 . Q:RAXAM(0)="" 18 . S RAORDER=+$P(RAXAM(0),"^",11) 19 . ; quit if exam is WAITING and its order status isn't ACTIVE 20 . ; because this means exam hasn't finished being registered 21 . I $P($G(^RA(72,+$P(RAXAM(0),U,3),0)),U,3)=1,$P($G(^RAO(75.1,RAORDER,0)),U,5)'=6 Q 22 . S RAORDER(7)=$P($G(^RAO(75.1,RAORDER,0)),"^",7) ; CPRS order ien 23 . S RAXSTAT=+$P(RAXAM(0),"^",3),RAXSTAT(0)=$G(^RA(72,RAXSTAT,0)) 24 . S RAXID=RAIBDT_"-"_RANO 25 . S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") 26 . S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) 27 . S RACPT=+$P(RAPRC,"^",9) ; pntr to 81 28 . S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT) 29 . S RACPT=$S($P(RACPT,"^",2)]"":$P(RACPT,"^"),1:"") 30 . S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") 31 . ; quit if cancelled exam, and cancelled exams not requested 32 . I ('$G(RACINC)),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) Q 33 . S RADIAG=+$P(RAXAM(0),U,13),RARPT=+$P(RAXAM(0),U,17) 34 .; E3R 17541, 15507 35 .; if want cancel'd cases returned, and this case is cancelled, then 36 .; also require div param ALLOW RPTS ON CANCELLED CASES? = Y and 37 .; presence of report, else skip this case 38 . I $G(RACINC),($P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0) D Q:RASHOCAN=0 39 .. S RASHOCAN=0 40 .. I $P($G(^RA(79,+$P(RAREX(0),"^",3),.1)),"^",22)="Y",RARPT S RASHOCAN=1 41 .. Q 42 . S RABNOR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,4)) 43 . S:RABNOR'="Y" RABNOR="" 44 . S RABNORMR=$$UP^XLFSTR($P($G(^RA(78.3,RADIAG,0)),U,3)) 45 . S:RABNORMR'="Y" RABNORMR="" 46 . S RARPTST=$P($G(^RARPT(RARPT,0)),U,5) 47 . S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") 48 . S ^TMP($J,"RAE1",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_RABNOR_U_$S(RARPT=0:"",1:RARPT)_U_$P(RAXSTAT(0),"^",3)_"~"_$P(RAXSTAT(0),"^")_U_RAILOC_U_$P(RAITY(0),"^",3)_"~"_$P(RAITY(0),"^")_U_RABNORMR_U_RACPT_U_$G(RAORDER(7)) 49 . S ^TMP($J,"RAE1",RADFN,RAXID)=^TMP($J,"RAE1",RADFN,RAXID)_U_$S($O(^RARPT(RARPT,2005,0)):"Y",1:"N") 50 . D CPTMOD 51 . S RACNT=RACNT+1 52 .; 53 .; Condensed Radiology Display in CPRS GUI: 54 .; subtract from count if counting parent; count only 1 case from printset 55 .; and 56 .; store values of MEMBER OF SET and ordered parent procedure name 57 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P" D 58 .. I $P(RAXAM(0),U,25)="2",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO),-1) S RACNT=RACNT-1 59 .. I $P(RAXAM(0),U,25) D 60 ... S RA3=$S('RAORDER:"",1:$P($G(^RAMIS(71,+$P($G(^RAO(75.1,+RAORDER,0)),U,2),0)),U)) 61 ... S RA3=$S(RA3'="":RA3,1:"PARENT PROCEDURE") 62 ... S ^TMP($J,"RAE1",RADFN,RAXID,"CPRS")=$P(RAXAM(0),U,25)_U_RA3 63 ... Q 64 .. Q 65 . S:RACNT=RAEXN RAXIT=1 66 .; Condensed Radiology Display in CPRS GUI: 67 .; do not exit until all cases of printset have been stored 68 . I $D(RAEXNP),$E(RAEXNP,$L(RAEXNP))="P",$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) S RAXIT=0 69 . K RAXSTAT,RAORDER 70 . Q 71 K RAILOC,RAITY 72 Q 73 CASE ; Return the case numbers and the total number of case numbers 74 ; associated with a particular order. Called from CASE^RAO7PC1. 75 ; Sets RARRAY(case #)="" for all cases associated with an order. 76 ; Sets first piece of RATTL to the number of cases found for an 77 ; order, and the second piece is PRINTSET if the report covers 78 ; multiple cases. See CASE^RAO7PC1 for more information. 79 I '$D(^RAO(75.1,RAOIFN,0))#2 S RATTL="-1^invalid order ien" Q 80 I '$D(^RADPT("AO",RAOIFN)) D Q ; case has yet to be registered 81 . S RATTL="-2^no case registered to date" 82 . Q 83 N RACNI,RADFN,RADTI,RAEXAM S RADFN=0 84 F S RADFN=$O(^RADPT("AO",RAOIFN,RADFN)) Q:RADFN'>0 D 85 . S RADTI=0 86 . F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D 87 .. S RACNI=0 88 .. F S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:RACNI'>0 D 89 ... S RAEXAM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 90 ... Q:$P($G(^RA(72,+$P(RAEXAM,"^",3),0)),"^",3)=0 ; xam cancelled 91 ... S RATTL=+$G(RATTL)+1,@(RARRAY_"("_+RAEXAM_")")="" 92 ... Q 93 .. Q 94 . Q 95 I 'RATTL S RATTL="-2^cases cancelled" Q 96 S:$P(RAEXAM,"^",25)=2 RATTL=RATTL_"^PRINTSET" ; combined reports 97 Q 98 ; 99 EN2 ; IA: 2012, Return last 7 days of non-cancelled exams 100 ; Required: RADFN (valid patient ien) called from EN2^RAO7PC1 101 ; Output: 102 ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^ 103 ; report status^imaging location IEN^imaging location name^ 104 ; contrast medium or media used 105 ; Note: Single characters in parenthesis indicate contrast 106 ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic; 107 ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin; 108 ; (B)=Barium; (M)=unspecified contrast media 109 ; 110 ; Exam ID: exam date/time (inverse) concatenated with the case IEN 111 ; 112 Q:'$D(RADFN) Q:'RADFN K ^TMP($J,"RAE7") 113 N I,RABDT,RACNST,RACSE,RADT,RAEDT,RAIBDT,RAIEDT,RALOC,RACMEDIA,RANO 114 N RAPRC,RAREX,RARPT,RARPTST,RAXAM,RAXID,RAXSTAT 115 S RADT=$S($D(DT)#2:DT,1:$$DT^XLFDT()),RACNST=9999999.9999 116 S RABDT=$$FMADD^XLFDT(RADT,-7,0,0,0),RAEDT=RADT 117 S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001) 118 F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D 119 . S RANO=0,RAREX(0)=$G(^RADPT(RADFN,"DT",RAIBDT,0)) 120 . S RALOC=+$P(RAREX(0),U,4),RALOC(0)=$G(^RA(79.1,RALOC,0)) 121 . S RALOC=$P($G(^SC(+RALOC(0),0)),"^") 122 . F S RANO=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO)) Q:RANO'>0 D 123 .. S RAXAM(0)=$G(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,0)) 124 .. S RAXID=RAIBDT_"-"_RANO 125 .. S RACSE=$S($P(RAXAM(0),U)]"":$P(RAXAM(0),U),1:"Unknown") 126 .. S RAPRC=$G(^RAMIS(71,+$P(RAXAM(0),U,2),0)) 127 .. S RAPRC=$S($P(RAPRC,U)]"":$P(RAPRC,U),1:"Unknown") 128 .. Q:$P($G(^RA(72,+$P(RAXAM(0),"^",3),0)),"^",3)=0 ; cancelled xam 129 .. S I=0,RACMEDIA="" F S I=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CM",I)) Q:'I S RACMEDIA=RACMEDIA_$P(^(I,0),U) ;RA*5*45 130 .. S RARPT=+$P(RAXAM(0),U,17) 131 .. S RARPTST=$P($G(^RARPT(RARPT,0)),U,5) 132 .. S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") 133 .. S ^TMP($J,"RAE7",RADFN,RAXID)=RAPRC_U_RACSE_U_RARPTST_U_+RALOC(0)_U_RALOC_U_RACMEDIA 134 .. Q 135 . Q 136 Q 137 CPTMOD ;extract cpt modifiers if any 138 ;RA loop var, RA1 counter, RA2 intermed vars 139 Q:'$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",0)) 140 S RA=0,RA1=1 141 F S RA=$O(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA)) Q:'RA I $D(^(RA,0)) D 142 . S RA2=$P(^RADPT(RADFN,"DT",RAIBDT,"P",RANO,"CMOD",RA,0),"^") 143 . S RA2=$$BASICMOD^RACPTMSC(RA2,+RAREX(0)) Q:+RA2<0 144 . S ^TMP($J,"RAE1",RADFN,RAXID,"CMOD",RA1)=$P(RA2,"^",2)_"^"_$P(RA2,"^",3),RA1=RA1+1 145 Q
Note:
See TracChangeset
for help on using the changeset viewer.
