- 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/RAO7PC2.m
r613 r623 1 RAO7PC2 ;HISC/GJC-Part two for Return Narrative (EN3^RAO7PC1);1/17/95 ;9/13/01 10:39 2 ;;5.0;Radiology/Nuclear Medicine;**1,11,14,16,22,27,45,75,56**;Mar 16, 1998;Build 3 3 ;Supported IA #10104 UP^XLFSTR 4 ;Supported IA #2055 EXTERNAL^DILFD 5 ;Supported IA #10060 ^VA(200 6 CASE(Y) ; Retrieve exam data for specified inverse exam date range. 7 ; 'Y'-> Exam node IEN 8 N RABNOR,RACNT,RAEXAM,RAI,RAIMPRES,RAINCLUD,RAOPRC,RAORD,RAPDIAG 9 N RAPIST,RAPIRE,RAPROC,RARDE,RADTI,RACNI,RADUPHX,RAREASDY 10 N RARPT,RARPTST,RARPTXT,RASBN,RASDIAG,RAVER,RAERRFLG,Z,Z1,Z2 11 S RACNT=1 12 S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,0)) Q:RAEXAM(0)']"" 13 S:$P(RAEXAM(0),"^",25)=2 RAPSET=1 14 S:RAPSET=1 ^TMP($J,"RAE2",RADFN,"PRINT_SET")="" ; xam set with same rpt 15 S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0)) 16 S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown") 17 S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0)) 18 S RAORD(7)=$P(RAORD(0),"^",7) ; CPRS order ien 19 S RAREASDY=$P($G(^RAO(75.1,+$P(RAEXAM(0),"^",11),.1)),"^") ;REASON FOR STUDY 20 S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0)) 21 S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown") 22 S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0)) 23 S RAPDIAG=$P(RAPDIAG(0),"^"),RARPT=+$P(RAEXAM(0),"^",17) 24 S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$$UL^RAO7PC1A($$RSTAT^RAO7PC1A()) 25 ; set the following flag variable: RAINCLUD 26 ; RAINCLUD=$S(RPT STATUS=verif'd or released/unverif'd:1,1:0) 27 S RAINCLUD=$S("RV"[$E(RARPTST):1,1:0) 28 I $E(RARPTST)="V",(RAPSET'<0) D 29 . S RAVER=$P(RARPT(0),"^",9),RASBN=$P($G(^VA(200,+RAVER,20)),"^",2) 30 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"V")=RAVER_"^"_RASBN 31 . Q 32 S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 33 I RAPDIAG]"",(RAINCLUD),(RAPSET'<0) D ; if diag & verif'd or released/unverif'd & first pass if part of xam set (many xams - one rpt) 34 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RAPDIAG 35 . Q 36 S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"RFS")=RAREASDY ;REASON FOR STUDY 37 ; 1st, get clnhist from file70. 2nd, get addl clnhist form file74 38 ; 1st: 39 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",0)) D 40 . N RAI S (RAI,Z)=0 41 . F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z)) Q:Z'>0 D 42 .. S RAI=RAI+1 43 .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"H",RAI)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z,0)) 44 .. Q 45 . Q 46 ;2nd: 47 S RADTI=RAINVXDT,RACNI=Y D CHKDUPHX^RART1 ;chk if file74 clnhist is dupl 48 I 'RADUPHX,$O(^RARPT(RARPT,"H",0)) S Z="H" D RPTXT(RARPT,Z) 49 ; 50 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",0)) D ; save modifiers 51 . N RAI S (RAI,Z)=0 52 . F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z)) Q:Z'>0 D 53 .. S RAI=RAI+1 54 .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"M",RAI)=$P($G(^RAMIS(71.2,+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z,0)),0)),"^") 55 .. Q 56 . Q 57 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",0)),(RAPSET'<0) D 58 . S Z=0 F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z)) Q:Z'>0 D 59 .. S RASDIAG=+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z,0)) 60 .. S RASDIAG(0)=$G(^RA(78.3,RASDIAG,0)),RASDIAG(1)=$P(RASDIAG(0),"^") 61 .. I RASDIAG(1)]"",(RAINCLUD) D 62 ... S RACNT=RACNT+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RASDIAG(1) 63 ... I RABNOR'="Y" D 64 .... S RABNOR=$$UP^XLFSTR($P(RASDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 65 .... Q 66 ... Q 67 .. Q 68 . Q 69 I RAINCLUD,(RAPSET'<0) D 70 . I +$O(^RARPT(RARPT,"I",0)) S Z="I" D RPTXT(RARPT,Z) 71 . I +$O(^RARPT(RARPT,"R",0)) S Z="R" D RPTXT(RARPT,Z) 72 . Q 73 I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD")=RAOPRC 74 I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD",Y)=RAOPRC 75 ; 76 ; Check to see if amended report 77 I RAPSET'<0,+$O(^RARPT(RARPT,"ERR",0)) S RAERRFLG="A" 78 ; 79 S:RAPSET'<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)=RARPTST_"^"_$G(RABNOR)_"^"_$G(RAORD(7))_"^"_$G(RAERRFLG) 80 S:RAPSET<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)="" 81 S:RAPSET=1 RAPSET=-1 82 ; 83 I RARPTST'="No Report" D 84 .; Add Prim Int Staff, Prim Int Resident & Reported Date 85 .S RAPIST=$P(RAEXAM(0),"^",15) 86 .S RAPIRE=$P(RAEXAM(0),"^",12) 87 .S RARDE=$P(RARPT(0),"^",8) 88 .S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"P")=RAPIST_"^"_RAPIRE_"^"_RARDE 89 ;If contrast media was involved in the exam pass that information. 90 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",0)) S (RACNT,RAI)=0 D 91 .F S RAI=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI)) Q:'RAI D 92 ..S RACNT=RACNT+1 93 ..S RAI(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI,0)) 94 ..S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"CM",RACNT)=$P(RAI(0),U)_"^"_$$EXTERNAL^DILFD(70.3225,.01,"",$P(RAI(0),U)) 95 ..Q 96 Q 97 ; 98 RPTXT(RARPT,Z) ; Retrieve report text & store in ^TMP 99 ; 'RARPT' -> Report IEN 100 ; 'Z' -> "I":Impression Text <> "R":Report Text 101 S (Z1,Z2)=0 102 ;file 74's "H" nodes are now additional clinical history 103 I Z="H" S Z2=$O(^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,""),-1) I $O(^RARPT(RARPT,Z,Z1)) S Z2=Z2+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)="Additional Clinical History:" 104 F S Z1=$O(^RARPT(RARPT,Z,Z1)) Q:Z1'>0 D 105 . S Z1(0)=$G(^RARPT(RARPT,Z,Z1,0)),Z2=Z2+1 106 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)=Z1(0) 107 . Q 108 Q 109 ; 110 CLIN(DFN,PROCLIST) ;Radiology and Clinical Reminders API 111 ; 112 ; Created by Cameron Taylor March 1999 113 ; 114 ; This API recieves a patient and a list of procedures. For each 115 ; Procedure, the details of the last 'complete' procedure and/or the 116 ; last 'cancelled' & 'in progress' procedure details and returns them 117 ; in ^TMP($J,"RADPROC" 118 N XX,PROC,DATE,STATUS,PROVIDER,EXAM,X,Y,EXAMIEN,RADPTIEN,ORDER,SUCCESS 119 ; 120 S DFN=$G(DFN) ; Patient Name 121 S PROCLIST=$G(PROCLIST) ; List of Procedures (separated by '^') 122 K ^TMP($J,"RADPROC") 123 ; 124 S RADPTIEN=$O(^RADPT("B",DFN,"")) 125 I (RADPTIEN="")!(RADPTIEN=0) D Q 126 .S ^TMP($J,"RADPROC")="Invalid/Unknown Radiology Patient" 127 ; 128 F XX=1:1 S PROC=$P(PROCLIST,U,XX) Q:PROC="" D 129 .S SUCCESS=0 ; Quit searching if SUCCESS=3 (comp, canc & in prog) 130 .S DATE=0 F S DATE=$O(^RADPT(RADPTIEN,"DT",DATE)) Q:DATE'?7N1".".N!(SUCCESS=3) D 131 ..S EXAMIEN=0 F S EXAMIEN=$O(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN)) Q:'EXAMIEN!(SUCCESS=3) D 132 ...S EXAM=$G(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN,0)) 133 ...Q:$P(EXAM,U,2)'=PROC 134 ...; 135 ...; Continue, get STATUS and ORDER 136 ...; (0 is cancelled, 1-8 in progress & 9 is COMPLETE) 137 ...; (ignore if null) 138 ...; 139 ...S STATUS=$P(EXAM,U,3) 140 ...I STATUS'="" D 141 ....S ORDER=$P(^RA(72,STATUS,0),U,3) 142 ....S STATUS=$P(^RA(72,STATUS,0),U) ; description 143 ...; 144 ...; Only one of each type (ORDER) 145 ...; 146 ...Q:ORDER="" 147 ...I ORDER=0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"CANCELLED")) S ORDER="CANCELLED" 148 ...I ORDER=9 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"COMPLETE")) S ORDER="COMPLETE" 149 ...I ORDER<9,ORDER>0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"IN PROGRESS")) S ORDER="IN PROGRESS" 150 ...; 151 ...; Now for the PROVIDER. Check PRIMARY INTERPRETING STAFF 152 ...; if none, then default to PRIMARY INTERPRETING RESIDENT. 153 ...; 154 ...S PROVIDER=$P(EXAM,U,15) 155 ...S:PROVIDER="" PROVIDER=$P(EXAM,U,12) 156 ...S:PROVIDER'="" PROVIDER=$P($G(^VA(200,PROVIDER,0)),U,1) ; description 157 ...; 158 ...; Create return info. on ^TMP (1st manipulate DATE) 159 ...; 160 ...S Y=9999999.9999-DATE 161 ...S ^TMP($J,"RADPROC",RADPTIEN,PROC,ORDER)=Y_U_STATUS_U_PROVIDER 162 ...S SUCCESS=SUCCESS+1 163 .; 164 .; Finished searching Patient file. Any Procedures with no activity? 165 .; 166 .I '$D(^TMP($J,"RADPROC",RADPTIEN,PROC)) S ^TMP($J,"RADPROC",RADPTIEN,PROC,"NONE")="" 167 Q 168 ; 1 RAO7PC2 ;HISC/GJC-Part two for Return Narrative (EN3^RAO7PC1);1/17/95 ;9/13/01 10:39 2 ;;5.0;Radiology/Nuclear Medicine;**1,11,14,16,22,27,45,75**;Mar 16, 1998;Build 4 3 CASE(Y) ; Retrieve exam data for specified inverse exam date range. 4 ; 'Y'-> Exam node IEN 5 N RABNOR,RACNT,RAEXAM,RAI,RAIMPRES,RAINCLUD,RAOPRC,RAORD,RAPDIAG 6 N RAPIST,RAPIRE,RAPROC,RARDE,RADTI,RACNI,RADUPHX,RAREASDY 7 N RARPT,RARPTST,RARPTXT,RASBN,RASDIAG,RAVER,RAERRFLG,Z,Z1,Z2 8 S RACNT=1 9 S RAEXAM(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,0)) Q:RAEXAM(0)']"" 10 S:$P(RAEXAM(0),"^",25)=2 RAPSET=1 11 S:RAPSET=1 ^TMP($J,"RAE2",RADFN,"PRINT_SET")="" ; xam set with same rpt 12 S RAPROC(0)=$G(^RAMIS(71,+$P(RAEXAM(0),"^",2),0)) 13 S RAPROC=$S($P(RAPROC(0),"^")]"":$P(RAPROC(0),"^"),1:"Unknown") 14 S RAORD(0)=$G(^RAO(75.1,+$P(RAEXAM(0),"^",11),0)) 15 S RAORD(7)=$P(RAORD(0),"^",7) ; CPRS order ien 16 S RAREASDY=$P($G(^RAO(75.1,+$P(RAEXAM(0),"^",11),.1)),"^") ;REASON FOR STUDY 17 S RAOPRC(0)=$G(^RAMIS(71,+$P(RAORD(0),"^",2),0)) 18 S RAOPRC=$S($P(RAOPRC(0),"^")]"":$P(RAOPRC(0),"^"),1:"Unknown") 19 S RAPDIAG(0)=$G(^RA(78.3,+$P(RAEXAM(0),"^",13),0)) 20 S RAPDIAG=$P(RAPDIAG(0),"^"),RARPT=+$P(RAEXAM(0),"^",17) 21 S RARPT(0)=$G(^RARPT(RARPT,0)),RARPTST=$P(RARPT(0),"^",5) 22 S RARPTST=$S(RARPTST="V":"Verified",RARPTST="R":"Released/Not verified",RARPTST="D":"Draft",RARPTST="PD":"Problem Draft",1:"No Report") 23 ; set the following flag variable: RAINCLUD 24 ; RAINCLUD=$S(RPT STATUS=verif'd or released/unverif'd:1,1:0) 25 S RAINCLUD=$S("RV"[$E(RARPTST):1,1:0) 26 I $E(RARPTST)="V",(RAPSET'<0) D 27 . S RAVER=$P(RARPT(0),"^",9),RASBN=$P($G(^VA(200,+RAVER,20)),"^",2) 28 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"V")=RAVER_"^"_RASBN 29 . Q 30 S RABNOR=$$UP^XLFSTR($P(RAPDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 31 I RAPDIAG]"",(RAINCLUD),(RAPSET'<0) D ; if diag & verif'd or released/unverif'd & first pass if part of xam set (many xams - one rpt) 32 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RAPDIAG 33 . Q 34 S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"RFS")=RAREASDY ;REASON FOR STUDY 35 ; 1st, get clnhist from file70. 2nd, get addl clnhist form file74 36 ; 1st: 37 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",0)) D 38 . N RAI S (RAI,Z)=0 39 . F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z)) Q:Z'>0 D 40 .. S RAI=RAI+1 41 .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"H",RAI)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"H",Z,0)) 42 .. Q 43 . Q 44 ;2nd: 45 S RADTI=RAINVXDT,RACNI=Y D CHKDUPHX^RART1 ;chk if file74 clnhist is dupl 46 I 'RADUPHX,$O(^RARPT(RARPT,"H",0)) S Z="H" D RPTXT(RARPT,Z) 47 ; 48 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",0)) D ; save modifiers 49 . N RAI S (RAI,Z)=0 50 . F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z)) Q:Z'>0 D 51 .. S RAI=RAI+1 52 .. S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"M",RAI)=$P($G(^RAMIS(71.2,+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"M",Z,0)),0)),"^") 53 .. Q 54 . Q 55 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",0)),(RAPSET'<0) D 56 . S Z=0 F S Z=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z)) Q:Z'>0 D 57 .. S RASDIAG=+$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"DX",Z,0)) 58 .. S RASDIAG(0)=$G(^RA(78.3,RASDIAG,0)),RASDIAG(1)=$P(RASDIAG(0),"^") 59 .. I RASDIAG(1)]"",(RAINCLUD) D 60 ... S RACNT=RACNT+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,"D",RACNT)=RASDIAG(1) 61 ... I RABNOR'="Y" D 62 .... S RABNOR=$$UP^XLFSTR($P(RASDIAG(0),"^",4)) S:RABNOR'="Y" RABNOR="" 63 .... Q 64 ... Q 65 .. Q 66 . Q 67 I RAINCLUD,(RAPSET'<0) D 68 . I +$O(^RARPT(RARPT,"I",0)) S Z="I" D RPTXT(RARPT,Z) 69 . I +$O(^RARPT(RARPT,"R",0)) S Z="R" D RPTXT(RARPT,Z) 70 . Q 71 I $P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD")=RAOPRC 72 I '$P(RAEXAM(0),"^",25) S ^TMP($J,"RAE2",RADFN,"ORD",Y)=RAOPRC 73 ; 74 ; Check to see if amended report 75 I RAPSET'<0,+$O(^RARPT(RARPT,"ERR",0)) S RAERRFLG="A" 76 ; 77 S:RAPSET'<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)=RARPTST_"^"_$G(RABNOR)_"^"_$G(RAORD(7))_"^"_$G(RAERRFLG) 78 S:RAPSET<0 ^TMP($J,"RAE2",RADFN,Y,RAPROC)="" 79 S:RAPSET=1 RAPSET=-1 80 ; 81 I RARPTST'="No Report" D 82 .; Add Prim Int Staff, Prim Int Resident & Reported Date 83 .S RAPIST=$P(RAEXAM(0),"^",15) 84 .S RAPIRE=$P(RAEXAM(0),"^",12) 85 .S RARDE=$P(RARPT(0),"^",8) 86 .S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"P")=RAPIST_"^"_RAPIRE_"^"_RARDE 87 ;If contrast media was involved in the exam pass that information. 88 I +$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",0)) S (RACNT,RAI)=0 D 89 .F S RAI=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI)) Q:'RAI D 90 ..S RACNT=RACNT+1 91 ..S RAI(0)=$G(^RADPT(RADFN,"DT",RAINVXDT,"P",Y,"CM",RAI,0)) 92 ..S ^TMP($J,"RAE2",RADFN,Y,RAPROC,"CM",RACNT)=$P(RAI(0),U)_"^"_$$EXTERNAL^DILFD(70.3225,.01,"",$P(RAI(0),U)) 93 ..Q 94 Q 95 ; 96 RPTXT(RARPT,Z) ; Retrieve report text & store in ^TMP 97 ; 'RARPT' -> Report IEN 98 ; 'Z' -> "I":Impression Text <> "R":Report Text 99 S (Z1,Z2)=0 100 ;file 74's "H" nodes are now additional clinical history 101 I Z="H" S Z2=$O(^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,""),-1) I $O(^RARPT(RARPT,Z,Z1)) S Z2=Z2+1,^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)="Additional Clinical History:" 102 F S Z1=$O(^RARPT(RARPT,Z,Z1)) Q:Z1'>0 D 103 . S Z1(0)=$G(^RARPT(RARPT,Z,Z1,0)),Z2=Z2+1 104 . S ^TMP($J,"RAE2",RADFN,Y,RAPROC,Z,Z2)=Z1(0) 105 . Q 106 Q 107 ; 108 CLIN(DFN,PROCLIST) ;Radiology and Clinical Reminders API 109 ; 110 ; Created by Cameron Taylor March 1999 111 ; 112 ; This API recieves a patient and a list of procedures. For each 113 ; Procedure, the details of the last 'complete' procedure and/or the 114 ; last 'cancelled' & 'in progress' procedure details and returns them 115 ; in ^TMP($J,"RADPROC" 116 N XX,PROC,DATE,STATUS,PROVIDER,EXAM,X,Y,EXAMIEN,RADPTIEN,ORDER,SUCCESS 117 ; 118 S DFN=$G(DFN) ; Patient Name 119 S PROCLIST=$G(PROCLIST) ; List of Procedures (separated by '^') 120 K ^TMP($J,"RADPROC") 121 ; 122 S RADPTIEN=$O(^RADPT("B",DFN,"")) 123 I (RADPTIEN="")!(RADPTIEN=0) D Q 124 .S ^TMP($J,"RADPROC")="Invalid/Unknown Radiology Patient" 125 ; 126 F XX=1:1 S PROC=$P(PROCLIST,U,XX) Q:PROC="" D 127 .S SUCCESS=0 ; Quit searching if SUCCESS=3 (comp, canc & in prog) 128 .S DATE=0 F S DATE=$O(^RADPT(RADPTIEN,"DT",DATE)) Q:DATE'?7N1".".N!(SUCCESS=3) D 129 ..S EXAMIEN=0 F S EXAMIEN=$O(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN)) Q:'EXAMIEN!(SUCCESS=3) D 130 ...S EXAM=$G(^RADPT(RADPTIEN,"DT",DATE,"P",EXAMIEN,0)) 131 ...Q:$P(EXAM,U,2)'=PROC 132 ...; 133 ...; Continue, get STATUS and ORDER 134 ...; (0 is cancelled, 1-8 in progress & 9 is COMPLETE) 135 ...; (ignore if null) 136 ...; 137 ...S STATUS=$P(EXAM,U,3) 138 ...I STATUS'="" D 139 ....S ORDER=$P(^RA(72,STATUS,0),U,3) 140 ....S STATUS=$P(^RA(72,STATUS,0),U) ; description 141 ...; 142 ...; Only one of each type (ORDER) 143 ...; 144 ...Q:ORDER="" 145 ...I ORDER=0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"CANCELLED")) S ORDER="CANCELLED" 146 ...I ORDER=9 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"COMPLETE")) S ORDER="COMPLETE" 147 ...I ORDER<9,ORDER>0 Q:$D(^TMP($J,"RADPROC",RADPTIEN,PROC,"IN PROGRESS")) S ORDER="IN PROGRESS" 148 ...; 149 ...; Now for the PROVIDER. Check PRIMARY INTERPRETING STAFF 150 ...; if none, then default to PRIMARY INTERPRETING RESIDENT. 151 ...; 152 ...S PROVIDER=$P(EXAM,U,15) 153 ...S:PROVIDER="" PROVIDER=$P(EXAM,U,12) 154 ...S:PROVIDER'="" PROVIDER=$P($G(^VA(200,PROVIDER,0)),U,1) ; description 155 ...; 156 ...; Create return info. on ^TMP (1st manipulate DATE) 157 ...; 158 ...S Y=9999999.9999-DATE 159 ...S ^TMP($J,"RADPROC",RADPTIEN,PROC,ORDER)=Y_U_STATUS_U_PROVIDER 160 ...S SUCCESS=SUCCESS+1 161 .; 162 .; Finished searching Patient file. Any Procedures with no activity? 163 .; 164 .I '$D(^TMP($J,"RADPROC",RADPTIEN,PROC)) S ^TMP($J,"RADPROC",RADPTIEN,PROC,"NONE")="" 165 Q 166 ;
Note:
See TracChangeset
for help on using the changeset viewer.
