- 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/RAO7PC3.m
r613 r623 1 RAO7PC3 ;HISC/SWM&CRT-Procedure Call utilities. ;7/30/01 10:28 2 ;;5.0;Radiology/Nuclear Medicine;**16,26,27,56**;Mar 16, 1998;Build 3 3 ;Supported IA #2056 GET1^DIQ 4 ;Supported IA 10104 UP^XLFSTR 5 ;; api to return entire report (same as auto e-mail's) 6 EN3(X) ; Return narrative text for exam(s) 7 ; Input: 8 ; X-> Exam id in one of two forms: 9 ; 1) Pat. DFN^inv. exam date^Case IEN 10 ; Retrieves a single report for a single exam 11 ; 2) Pat. DFN^inv. exam date^ 12 ; Retrieves all reports for a set of exams ordered on one order 13 ; 14 ; Note: Input delimiter can be any of the following: ^~\&;- 15 ; a delimiter may be a single space i.e, " " 16 ; 17 ; Output: 18 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name)=report status^ 19 ; abnormal alert^CPRS Order ien 20 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name,n)=line n of rpt 21 ; ^TMP($J,"RAE3",Patient IEN,"PRINT_SET")=null (IF this is a printset) 22 ; ^TMP($J,"RAE3",Patient IEN,"ORD")=name of ordered procedure for 23 ; examsets and printsets 24 ; ^TMP($J,"RAE3",Patient IEN,"ORD",case IEN)=name of ordered procedure 25 ; for that case; not part of an examset or printset 26 ; 27 ; 28 K ^TMP($J,"RAE3"),^TMP($J,"RA AUTOE") 29 K RAU S RAU=$$DEL^RAO7PC1(X) I RAU="" K RAU Q 30 Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT 31 N RACIEN,RADFN,RAINVXDT,RAPSET,RAUTOE,Y S RAPSET=0 32 S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3) 33 K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2) 34 I RACIEN D CASE(RACIEN) Q 35 S Y=0 36 F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D 37 . D CASE(Y) S RAPSET=0 38 . Q 39 Q 40 EN30(RAOIFN) ; Return narrative text for exam(s). 41 ; To be used with the EN3 entry point above. 42 ; 43 ; Input: RAOIFN -> the ien of Rad/Nuc Med Order 44 ; 45 Q:'RAOIFN ; order passed in as 0 or null 46 Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order 47 Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order 48 N RADFN,RADTI,RACNI,RAXSET 49 S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN 50 S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI 51 S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1 52 I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code 53 ; the following code is executed for non-exam set examinations 54 S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI 55 D EN3(RADFN_"^"_RADTI_"^"_RACNI) 56 Q 57 CASE(Y) ; 58 N N,RABNOR,RACASE,RACIEN,RADIAG,RAEXAM,RAINCLUD,RAOPRC,RAORD,BLANK 59 N RAMSG,RAPDIAG,RAPROC,RARDE,RARPT,RARPTST,RASPACE,SKIP,X,ZZRADFN,X0,X1,X2,RASIGVES,RARPTST2 60 ; 61 S RACIEN=Y,$P(BLANK," ",80)="" 62 S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,0)) Q:RAEXAM(0)']"" 63 S RACASE=$P(RAEXAM(0),"^") 64 S:$P(RAEXAM(0),"^",25)=2 RAPSET=1 65 S:RAPSET=1 ^TMP($J,"RAE3",RADFN,"PRINT_SET")="" 66 S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0)) 67 S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown") 68 S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0)) 69 S RAORD(7)=$P(RAORD(0),"^",7) 70 S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0)) 71 S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown") 72 S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0)) 73 S RARPT=+$P(RAEXAM(0),"^",17),RARPTST2=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A()) 74 S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$P(RARPT(0),"^",5) 75 S RASIGVES="" I RARPTST="V",$P(RARPT(0),U,10)]"",$P(RARPT(0),U,9)]"" S X2=RARPT,X1=$P(RARPT(0),U,9),X=$P(RARPT(0),U,10) D DE^XUSHSHP S:X]"" RASIGVES="/ES/"_X 76 S RARDE=$$GET1^DIQ(74,RARPT_",",8,"E") 77 ; View whole report if Rad User or status is R or V. 78 D CHKUSR^RAUTL2 S RAINCLUD=RAMSG 79 S RAINCLUD=$S(RAMSG:1,RARPTST="V":1,RARPTST="R":1,1:0) 80 S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 81 ; 82 I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD")=RAOPRC 83 I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD",RACIEN)=RAOPRC 84 ; 85 I RAPSET'<0 D 86 .S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="^"_RABNOR_"^"_RAORD(7) 87 .S $P(^TMP($J,"RAE3",RADFN,RACIEN,RAPROC),"^")=RARPTST2 88 S:RAPSET<0 ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="" 89 S:RAPSET=1 RAPSET=-1 90 ; 91 ; Setup variables then call ^RARTR to create Rad Report on ^TMP nodes 92 ; 2 stages: INIT^RARTR creates header info, PRT1^RARTR for the report 93 ; (save RADFN as RARTR kills it at the end) 94 ; 95 S RAUTOE=1,ZZRADFN=RADFN,RAACNT=0 96 S X="^"_RADFN_"^"_(9999999.9999-RAINVXDT)_"^"_RACASE_"^"_RARPTST 97 ; 98 D INIT^RARTR 99 S (RAFFLF,RAORIOF)=$G(IOF) 100 I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q 101 ; 102 S RAVERF=0 103 I RARPTST2="No Report" D 104 .S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,"DT",RAINVXDT,0),"^",3) 105 .S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:""),RAMDV=$TR(RAMDV,"YNyn","1010") 106 D PRT1^RARTR 107 S RADFN=ZZRADFN 108 Q:'$D(^TMP($J,"RA AUTOE")) 109 ; 110 ; Now manipulate ^TMP($J,"RA AUTOE" and save as ^TMP($J,"RAE3" 111 ; Step 1: Change Case Number to Exam Date 112 ; Step 2: Remove Impression, Report & Diagnostic Codes if not 113 ; Released or Verified 114 ; Also remove "Att Phys" and "Pri Phys" 115 ; Step 3: Change Status to Report Status & add Reported Date 116 ; Step 4: If No Report then get Clin History from file #70. 117 ; ** WITH PATCH 27 - NO LONGER NEED TO DO STEP 4 ** 118 ; 119 STEP1 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1)=$P(^TMP($J,"RA AUTOE",1),"Case: ") 120 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1.5)="Exm Date: "_$$GET1^DIQ(70.02,RAINVXDT_","_RADFN_",",.01,"E") 121 ; 122 STEP2 K SKIP S N=1 F S N=$O(^TMP($J,"RA AUTOE",N)) Q:N="" D 123 . S X0=^TMP($J,"RA AUTOE",N),X1=$E(X0,1,10) 124 . I (X1="Att Phys: ")!(X1="Pri Phys: ") D 125 .. S ^TMP($J,"RA AUTOE",N)=$E(BLANK,1,41)_$E(X0,42,$L(X0)) 126 .. Q 127 .;I RARPTST2="No Report",($E(^TMP($J,"RA AUTOE",N),1,21)=" Clinical History:") D STEP4 128 .I $E(^TMP($J,"RA AUTOE",N),1,12)=" Report: " D STEP3 Q:RARPTST2="No Report" 129 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,15)=" Impression:" D 130 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 131 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,28)=" Primary Diagnostic Code:" D 132 ..S SKIP=1 S ^TMP($J,"RA AUTOE",N)=$E(^TMP($J,"RA AUTOE",N),1,28) 133 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,31)=" Secondary Diagnostic Codes:" D 134 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 135 .I $E(^TMP($J,"RA AUTOE",N),1,27)="Primary Interpreting Staff:" K SKIP 136 .I $D(SKIP) S SKIP=SKIP+1 137 .I $G(SKIP)<3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N)=^TMP($J,"RA AUTOE",N) 138 .Q 139 ; 140 XIT K ^TMP($J,"RA AUTOE") 141 Q 142 ; 143 STEP3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=" Report Status: "_RARPTST2 144 I RARPTST2="No Report" S N="^" Q 145 S $P(RASPACE," ",46)="" 146 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=^(N-0.4)_$E(RASPACE,1,46-$L(^(N-0.4)))_"Date Reported: "_RARDE 147 I RARPTST="V" D 148 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.3)=RASPACE_" Date Verified: "_$P($$GET1^DIQ(74,+$P(RAEXAM(0),"^",17),7),"@") 149 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.2)=" Verifier E-Sig:"_RASIGVES 150 . Q 151 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.1)="" 152 S ^TMP($J,"RA AUTOE",N)=" Report:" 153 I 'RAINCLUD S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 154 Q 155 ; 156 STEP4 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",0)) D 157 .N RAI,RAIN,Z S (RAI,Z)=0,RAIN=N_".000" 158 .F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z)) Q:Z'>0 D 159 ..S RAI=RAI+1 160 ..S RAIN=$E(RAIN,1,$L(RAIN)-$L(RAI))_RAI 161 ..S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,RAIN)=" "_$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z,0)) 162 Q 1 RAO7PC3 ;HISC/SWM&CRT-Procedure Call utilities. ;7/30/01 10:28 2 ;;5.0;Radiology/Nuclear Medicine;**16,26,27**;Mar 16, 1998 3 ;; api to return entire report (same as auto e-mail's) 4 EN3(X) ; Return narrative text for exam(s) 5 ; Input: 6 ; X-> Exam id in one of two forms: 7 ; 1) Pat. DFN^inv. exam date^Case IEN 8 ; Retrieves a single report for a single exam 9 ; 2) Pat. DFN^inv. exam date^ 10 ; Retrieves all reports for a set of exams ordered on one order 11 ; 12 ; Note: Input delimiter can be any of the following: ^~\&;- 13 ; a delimiter may be a single space i.e, " " 14 ; 15 ; Output: 16 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name)=report status^ 17 ; abnormal alert^CPRS Order ien 18 ; ^TMP($J,"RAE3",Patient IEN,case IEN,procedure name,n)=line n of rpt 19 ; ^TMP($J,"RAE3",Patient IEN,"PRINT_SET")=null (IF this is a printset) 20 ; ^TMP($J,"RAE3",Patient IEN,"ORD")=name of ordered procedure for 21 ; examsets and printsets 22 ; ^TMP($J,"RAE3",Patient IEN,"ORD",case IEN)=name of ordered procedure 23 ; for that case; not part of an examset or printset 24 ; 25 ; 26 K ^TMP($J,"RAE3"),^TMP($J,"RA AUTOE") 27 K RAU S RAU=$$DEL^RAO7PC1(X) I RAU="" K RAU Q 28 Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT 29 N RACIEN,RADFN,RAINVXDT,RAPSET,RAUTOE,Y S RAPSET=0 30 S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3) 31 K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2) 32 I RACIEN D CASE(RACIEN) Q 33 S Y=0 34 F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D 35 . D CASE(Y) S RAPSET=0 36 . Q 37 Q 38 EN30(RAOIFN) ; Return narrative text for exam(s). 39 ; To be used with the EN3 entry point above. 40 ; 41 ; Input: RAOIFN -> the ien of Rad/Nuc Med Order 42 ; 43 Q:'RAOIFN ; order passed in as 0 or null 44 Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order 45 Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order 46 N RADFN,RADTI,RACNI,RAXSET 47 S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN 48 S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI 49 S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1 50 I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code 51 ; the following code is executed for non-exam set examinations 52 S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI 53 D EN3(RADFN_"^"_RADTI_"^"_RACNI) 54 Q 55 CASE(Y) ; 56 N N,RABNOR,RACASE,RACIEN,RADIAG,RAEXAM,RAINCLUD,RAOPRC,RAORD,BLANK 57 N RAMSG,RAPDIAG,RAPROC,RARDE,RARPT,RARPTST,RASPACE,SKIP,X,ZZRADFN,X0,X1,X2,RASIGVES 58 ; 59 S RACIEN=Y,$P(BLANK," ",80)="" 60 S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,0)) Q:RAEXAM(0)']"" 61 S RACASE=$P(RAEXAM(0),"^") 62 S:$P(RAEXAM(0),"^",25)=2 RAPSET=1 63 S:RAPSET=1 ^TMP($J,"RAE3",RADFN,"PRINT_SET")="" 64 S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0)) 65 S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown") 66 S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0)) 67 S RAORD(7)=$P(RAORD(0),"^",7) 68 S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0)) 69 S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown") 70 S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0)) 71 S RARPT=+$P(RAEXAM(0),"^",17) 72 S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$P(RARPT(0),"^",5) 73 S RASIGVES="" I RARPTST="V",$P(RARPT(0),U,10)]"",$P(RARPT(0),U,9)]"" S X2=RARPT,X1=$P(RARPT(0),U,9),X=$P(RARPT(0),U,10) D DE^XUSHSHP S:X]"" RASIGVES="/ES/"_X 74 S RARDE=$$GET1^DIQ(74,RARPT_",",8,"E") 75 ; View whole report if Rad User or status is R or V. 76 D CHKUSR^RAUTL2 S RAINCLUD=RAMSG 77 S RAINCLUD=$S(RAMSG:1,RARPTST="V":1,RARPTST="R":1,1:0) 78 S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 79 ; 80 I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD")=RAOPRC 81 I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE3",RADFN,"ORD",RACIEN)=RAOPRC 82 ; 83 I RAPSET'<0 D 84 .S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="^"_RABNOR_"^"_RAORD(7) 85 .S $P(^TMP($J,"RAE3",RADFN,RACIEN,RAPROC),"^")=$$RPTST 86 S:RAPSET<0 ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC)="" 87 S:RAPSET=1 RAPSET=-1 88 ; 89 ; Setup variables then call ^RARTR to create Rad Report on ^TMP nodes 90 ; 2 stages: INIT^RARTR creates header info, PRT1^RARTR for the report 91 ; (save RADFN as RARTR kills it at the end) 92 ; 93 S RAUTOE=1,ZZRADFN=RADFN,RAACNT=0 94 S X="^"_RADFN_"^"_(9999999.9999-RAINVXDT)_"^"_RACASE_"^"_RARPTST 95 ; 96 D INIT^RARTR 97 S (RAFFLF,RAORIOF)=$G(IOF) 98 I RAY0<0!(RAY1<0)!(RAY2<0)!(RAY3<0) K RAFFLF Q 99 ; 100 S RAVERF=0 101 I $$RPTST="No Report" D 102 .S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,"DT",RAINVXDT,0),"^",3) 103 .S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:"") 104 D PRT1^RARTR 105 S RADFN=ZZRADFN 106 Q:'$D(^TMP($J,"RA AUTOE")) 107 ; 108 ; Now manipulate ^TMP($J,"RA AUTOE" and save as ^TMP($J,"RAE3" 109 ; Step 1: Change Case Number to Exam Date 110 ; Step 2: Remove Impression, Report & Diagnostic Codes if not 111 ; Released or Verified 112 ; Also remove "Att Phys" and "Pri Phys" 113 ; Step 3: Change Status to Report Status & add Reported Date 114 ; Step 4: If No Report then get Clin History from file #70. 115 ; ** WITH PATCH 27 - NO LONGER NEED TO DO STEP 4 ** 116 ; 117 STEP1 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1)=$P(^TMP($J,"RA AUTOE",1),"Case: ") 118 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,1.5)="Exm Date: "_$$GET1^DIQ(70.02,RAINVXDT_","_RADFN_",",.01,"E") 119 ; 120 STEP2 K SKIP S N=1 F S N=$O(^TMP($J,"RA AUTOE",N)) Q:N="" D 121 . S X0=^TMP($J,"RA AUTOE",N),X1=$E(X0,1,10) 122 . I (X1="Att Phys: ")!(X1="Pri Phys: ") D 123 .. S ^TMP($J,"RA AUTOE",N)=$E(BLANK,1,41)_$E(X0,42,$L(X0)) 124 .. Q 125 .;I $$RPTST="No Report",($E(^TMP($J,"RA AUTOE",N),1,21)=" Clinical History:") D STEP4 126 .I $E(^TMP($J,"RA AUTOE",N),1,12)=" Report: " D STEP3 Q:$$RPTST="No Report" 127 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,15)=" Impression:" D 128 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 129 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,28)=" Primary Diagnostic Code:" D 130 ..S SKIP=1 S ^TMP($J,"RA AUTOE",N)=$E(^TMP($J,"RA AUTOE",N),1,28) 131 .I 'RAINCLUD,$E(^TMP($J,"RA AUTOE",N),1,31)=" Secondary Diagnostic Codes:" D 132 ..S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 133 .I $E(^TMP($J,"RA AUTOE",N),1,27)="Primary Interpreting Staff:" K SKIP 134 .I $D(SKIP) S SKIP=SKIP+1 135 .I $G(SKIP)<3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N)=^TMP($J,"RA AUTOE",N) 136 .Q 137 ; 138 XIT K ^TMP($J,"RA AUTOE") 139 Q 140 ; 141 STEP3 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=" Report Status: "_$$RPTST 142 I $$RPTST="No Report" S N="^" Q 143 S $P(RASPACE," ",46)="" 144 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.4)=^(N-0.4)_$E(RASPACE,1,46-$L(^(N-0.4)))_"Date Reported: "_RARDE 145 I RARPTST="V" D 146 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.3)=RASPACE_" Date Verified: "_$P($$GET1^DIQ(74,+$P(RAEXAM(0),"^",17),7),"@") 147 . S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.2)=" Verifier E-Sig:"_RASIGVES 148 . Q 149 S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N-0.1)="" 150 S ^TMP($J,"RA AUTOE",N)=" Report:" 151 I 'RAINCLUD S SKIP=1,^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,N+0.1)="" 152 Q 153 ; 154 STEP4 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",0)) D 155 .N RAI,RAIN,Z S (RAI,Z)=0,RAIN=N_".000" 156 .F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z)) Q:Z'>0 D 157 ..S RAI=RAI+1 158 ..S RAIN=$E(RAIN,1,$L(RAIN)-$L(RAI))_RAI 159 ..S ^TMP($J,"RAE3",RADFN,RACIEN,RAPROC,RAIN)=" "_$G(^RADPT(RADFN,"DT",RAINVXDT,"P",RACIEN,"H",Z,0)) 160 Q 161 ; 162 RPTST() ; Return Full Report Status 163 Q $S(RARPTST="V":"Verified",RARPTST="R":"Released/Not Verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") 164 ;
Note:
See TracChangeset
for help on using the changeset viewer.
