- 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/RARTUVR3.m
r613 r623 1 RARTUVR3 ;HISC/GJC-Unverified Reports ;8/19/97 11:28 2 ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3 3 ;Supported IA #2056 GET1^DIQ 4 EN1 ; Entry point for unverified reports option when sort is on 5 ; Exam Date or Pri. Inter. Staff 6 ; Data Storage: 7 ; RABD="E": 8 ; ^TMP($J,"RAUVR",Division,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam 9 ; RABD="S": 10 ; ^TMP($J,"RAUVR",Pri. Staff,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam 11 K ^TMP($J,"RAUVR") S (RAOUT,RAPAGE)=0,RASTATUS="" 12 D:RABD="E" ZERO ; zero out totals for division data 13 S RADTE=BEGDATE-.0001 14 F S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>ENDDATE)!(RAOUT) D 15 . S RADFN=0 16 . F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0!(RAOUT) D 17 .. S RADTI=0 18 .. F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0!(RAOUT) D 19 ... S RACN=0 20 ... F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0!(RAOUT) D 21 .... S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI 22 .... S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 23 .... Q:'+$P(RA7003,"^",17) ; no report 24 .... S RA74=$G(^RARPT(+$P(RA7003,"^",17),0)) 25 .... Q:$P(RA74,"^",5)="" ; no status, skeletal rpt created by imaging 26 .... Q:"^V^X^EF^"[("^"_$P(RA74,"^",5)_"^") ;Skip Verified, Deleted, E-filed rpts 27 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT 28 .... ; ***** check if user selected this division & imaging type **** 29 .... S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) ; 0 node Reg. Exams sub-file 30 .... S RADIVNME=$P($G(^DIC(4,+$P(RA7002,"^",3),0)),"^") ; dinum to file 4! 31 .... S:RADIVNME="" RADIVNME="Unknown" 32 .... Q:'$D(^TMP($J,"RA D-TYPE",RADIVNME)) 33 .... Q:'$D(^TMP($J,"RA I-TYPE",$P($G(^RA(79.2,+$P(RA7002,"^",2),0)),"^"))) 34 .... ;***************************************************************** 35 .... S (RAMEMLOW,RAPRTSET,RAPSET)=0 D EN1^RAUTL20 ; mem of a printset? 36 .... S:RAPRTSET RAPSET="1." S:RAMEMLOW RAPSET="1+" 37 .... S RAPIS=$$GET1^DIQ(200,+$P(RA7003,"^",15)_",",.01) 38 .... S:RAPIS="" RAPIS="Unknown" 39 .... S RAPAT=$G(^DPT(RADFN,0)) 40 .... S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unknown" 41 .... S RAPAT=$P(RAPAT,"^") S:RAPAT="" RAPAT="Unknown" 42 .... ;***************************************************************** 43 .... ; Store off the data into our TMP global. First subscript is $J. 44 .... ; Second subscript is: RABD="E", exam date. I RABD="S", second 45 .... ; subscript is Pri. Int'g Staff. Other Subscripts: sub3-exam date, 46 .... ; sub4-patient name, sub5-case number 47 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003 48 .... S:RABD="S" ^TMP($J,"RAUVR",RAPIS,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003 49 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME)=+$G(^TMP($J,"RAUVR",RADIVNME))+1 50 .... ;***************************************************************** 51 .... Q 52 ... Q 53 .. Q 54 . Q 55 S:RABD="S" RAHD="UNVERIFIED IMAGING REPORTS BY PRIMARY INTERPRETING STAFF" 56 S:RABD="E" RAHD="UNVERIFIED IMAGING REPORTS BY DIVISION" 57 S $P(RADASH,"-",(IOM+1))="" 58 I '$D(^TMP($J,"RAUVR")) D Q 59 . N RA1,RANODATA S RANODATA="*** No Unverified Reports ***",RA1="" 60 . I RABD="S" D HDR W !!?(IOM-$L(RANODATA)\2),RANODATA 61 . I RABD="E" D 62 .. N RA1 63 .. S RA1="" F S RA=$O(^TMP($J,"RA D-TYPE",RA1)) Q:RA1="" D Q:RAOUT 64 ... D HDR 65 ... S RANODATA="*** No Unverified Reports for division: "_RA1_" ***" 66 ... W !!?(IOM-$L(RANODATA)\2),RANODATA 67 ... S:$O(^TMP($J,"RA D-TYPE",RA1))]"" RAOUT=$$EOS^RAUTL5() 68 ... Q 69 .. Q 70 . Q 71 D GETDATA 72 KILL ; cleanup symbol table 73 K RA7002,RA7003,RA74,RACSE,RAEXDT,RAHD,RAMEMLOW,RANODE,RAPAT,RAPIS 74 K RAPRC,RAPRTSET,RAPSET,RAXSTAT 75 Q 76 HDR ; header code 77 W:$Y @IOF ; clear screen if not at top-of-page 78 S RAPAGE=RAPAGE+1 W !?(IOM-$L(RAHD)\2),RAHD 79 W !,$S(RABD="S":"Primary Interpreting Staff: ",1:"Division: "),RA1 80 W ?94,$$FMTE^XLFDT(DT,"1P")_" Page: "_RAPAGE 81 W !,?87,"Exam",?96,"Report",!,"Patient",?21,"Patient ID",?38,"Exam Date",?48,"Case",?55,"Procedure",?87,"Status",?96,"Entered",?106,"Pri. Int'g Staff" 82 W !,RADASH 83 Q 84 GETDATA ; get to the data 85 S RA1="",(RAPAGE,RAOUT)=0 86 F S RA1=$O(^TMP($J,"RAUVR",RA1)) Q:RA1="" D Q:RAOUT 87 . D HDR S RAEXDT=0 88 . I RABD="E",$G(^TMP($J,"RAUVR",RA1))=0 D Q 89 .. S X="*** No Unverified Reports for division ***" 90 .. W !!?(IOM-$L(X)\2),X 91 .. S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5() 92 .. Q 93 . F S RAEXDT=$O(^TMP($J,"RAUVR",RA1,RAEXDT)) Q:RAEXDT'>0 D Q:RAOUT 94 .. S RAPAT="" 95 .. F S RAPAT=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT)) Q:RAPAT="" D Q:RAOUT 96 ... S RACSE=0 97 ... F S RACSE=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) Q:RACSE'>0 D Q:RAOUT 98 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT 99 .... S RANODE=$G(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) 100 .... D PRTDATA 101 .... Q 102 ... Q 103 .. Q 104 . S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5() 105 . Q 106 Q 107 PRTDATA ; print the data 108 S RAPRC=$E($S($P(^RAMIS(71,+$P(RANODE,"^",4),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,30) 109 S:+$P(RANODE,"^") RAPRC=$TR($P(RANODE,"^"),"1","")_RAPRC 110 S RAXSTAT=$E($S($P(^RA(72,+$P(RANODE,"^",5),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,7) 111 S RARPTENT=$$FMTE^XLFDT(($P($G(^RARPT(+$P(RANODE,"^",19),0)),"^",6)\1),"2P") 112 S:RABD="S" RAPIS=RA1 113 S:RABD="E" RAPIS=$$GET1^DIQ(200,+$P(RANODE,"^",17)_",",.01) 114 S:RAPIS="" RAPIS="Unknown" 115 W !,$E(RAPAT,1,20),?21,$P(RANODE,"^",2),?38,$$FMTE^XLFDT(RAEXDT,"2P"),?48,RACSE,?55,RAPRC,?87,RAXSTAT,?96,RARPTENT,?106,$E(RAPIS,1,25) 116 I $Y>(IOSL-4) S RAOUT=$$EOS^RAUTL5() D:'RAOUT HDR 117 Q 118 ZERO ; set division totals to zero 119 S X="" F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X="" S ^TMP($J,"RAUVR",X)=0 120 Q 1 RARTUVR3 ;HISC/GJC-Unverified Reports ;8/19/97 11:28 2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998 3 EN1 ; Entry point for unverified reports option when sort is on 4 ; Exam Date or Pri. Inter. Staff 5 ; Data Storage: 6 ; RABD="E": 7 ; ^TMP($J,"RAUVR",Division,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam 8 ; RABD="S": 9 ; ^TMP($J,"RAUVR",Pri. Staff,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam 10 K ^TMP($J,"RAUVR") S (RAOUT,RAPAGE)=0,RASTATUS="" 11 D:RABD="E" ZERO ; zero out totals for division data 12 S RADTE=BEGDATE-.0001 13 F S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>ENDDATE)!(RAOUT) D 14 . S RADFN=0 15 . F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0!(RAOUT) D 16 .. S RADTI=0 17 .. F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0!(RAOUT) D 18 ... S RACN=0 19 ... F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0!(RAOUT) D 20 .... S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI 21 .... S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) 22 .... Q:'+$P(RA7003,"^",17) ; no report 23 .... S RA74=$G(^RARPT(+$P(RA7003,"^",17),0)) 24 .... Q:$P(RA74,"^",5)="" ; no status, skeletal rpt created by imaging 25 .... Q:$P(RA74,"^",5)="V" ; verified, quit 26 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT 27 .... ; ***** check if user selected this division & imaging type **** 28 .... S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) ; 0 node Reg. Exams sub-file 29 .... S RADIVNME=$P($G(^DIC(4,+$P(RA7002,"^",3),0)),"^") ; dinum to file 4! 30 .... S:RADIVNME="" RADIVNME="Unknown" 31 .... Q:'$D(^TMP($J,"RA D-TYPE",RADIVNME)) 32 .... Q:'$D(^TMP($J,"RA I-TYPE",$P($G(^RA(79.2,+$P(RA7002,"^",2),0)),"^"))) 33 .... ;***************************************************************** 34 .... S (RAMEMLOW,RAPRTSET,RAPSET)=0 D EN1^RAUTL20 ; mem of a printset? 35 .... S:RAPRTSET RAPSET="1." S:RAMEMLOW RAPSET="1+" 36 .... S RAPIS=$P($G(^VA(200,+$P(RA7003,"^",15),0)),"^") 37 .... S:RAPIS="" RAPIS="Unknown" 38 .... S RAPAT=$G(^DPT(RADFN,0)) 39 .... S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unknown" 40 .... S RAPAT=$P(RAPAT,"^") S:RAPAT="" RAPAT="Unknown" 41 .... ;***************************************************************** 42 .... ; Store off the data into our TMP global. First subscript is $J. 43 .... ; Second subscript is: RABD="E", exam date. I RABD="S", second 44 .... ; subscript is Pri. Int'g Staff. Other Subscripts: sub3-exam date, 45 .... ; sub4-patient name, sub5-case number 46 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003 47 .... S:RABD="S" ^TMP($J,"RAUVR",RAPIS,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003 48 .... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME)=+$G(^TMP($J,"RAUVR",RADIVNME))+1 49 .... ;***************************************************************** 50 .... Q 51 ... Q 52 .. Q 53 . Q 54 S:RABD="S" RAHD="UNVERIFIED IMAGING REPORTS BY PRIMARY INTERPRETING STAFF" 55 S:RABD="E" RAHD="UNVERIFIED IMAGING REPORTS BY DIVISION" 56 S $P(RADASH,"-",(IOM+1))="" 57 I '$D(^TMP($J,"RAUVR")) D Q 58 . N RA1,RANODATA S RANODATA="*** No Unverified Reports ***",RA1="" 59 . I RABD="S" D HDR W !!?(IOM-$L(RANODATA)\2),RANODATA 60 . I RABD="E" D 61 .. N RA1 62 .. S RA1="" F S RA=$O(^TMP($J,"RA D-TYPE",RA1)) Q:RA1="" D Q:RAOUT 63 ... D HDR 64 ... S RANODATA="*** No Unverified Reports for division: "_RA1_" ***" 65 ... W !!?(IOM-$L(RANODATA)\2),RANODATA 66 ... S:$O(^TMP($J,"RA D-TYPE",RA1))]"" RAOUT=$$EOS^RAUTL5() 67 ... Q 68 .. Q 69 . Q 70 D GETDATA 71 KILL ; cleanup symbol table 72 K RA7002,RA7003,RA74,RACSE,RAEXDT,RAHD,RAMEMLOW,RANODE,RAPAT,RAPIS 73 K RAPRC,RAPRTSET,RAPSET,RAXSTAT 74 Q 75 HDR ; header code 76 W:$Y @IOF ; clear screen if not at top-of-page 77 S RAPAGE=RAPAGE+1 W !?(IOM-$L(RAHD)\2),RAHD 78 W !,$S(RABD="S":"Primary Interpreting Staff: ",1:"Division: "),RA1 79 W ?94,$$FMTE^XLFDT(DT,"1P")_" Page: "_RAPAGE 80 W !,?87,"Exam",?96,"Report",!,"Patient",?21,"Patient ID",?38,"Exam Date",?48,"Case",?55,"Procedure",?87,"Status",?96,"Entered",?106,"Pri. Int'g Staff" 81 W !,RADASH 82 Q 83 GETDATA ; get to the data 84 S RA1="",(RAPAGE,RAOUT)=0 85 F S RA1=$O(^TMP($J,"RAUVR",RA1)) Q:RA1="" D Q:RAOUT 86 . D HDR S RAEXDT=0 87 . I RABD="E",$G(^TMP($J,"RAUVR",RA1))=0 D Q 88 .. S X="*** No Unverified Reports for division ***" 89 .. W !!?(IOM-$L(X)\2),X 90 .. S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5() 91 .. Q 92 . F S RAEXDT=$O(^TMP($J,"RAUVR",RA1,RAEXDT)) Q:RAEXDT'>0 D Q:RAOUT 93 .. S RAPAT="" 94 .. F S RAPAT=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT)) Q:RAPAT="" D Q:RAOUT 95 ... S RACSE=0 96 ... F S RACSE=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) Q:RACSE'>0 D Q:RAOUT 97 .... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT 98 .... S RANODE=$G(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) 99 .... D PRTDATA 100 .... Q 101 ... Q 102 .. Q 103 . S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5() 104 . Q 105 Q 106 PRTDATA ; print the data 107 S RAPRC=$E($S($P(^RAMIS(71,+$P(RANODE,"^",4),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,30) 108 S:+$P(RANODE,"^") RAPRC=$TR($P(RANODE,"^"),"1","")_RAPRC 109 S RAXSTAT=$E($S($P(^RA(72,+$P(RANODE,"^",5),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,7) 110 S RARPTENT=$$FMTE^XLFDT(($P($G(^RARPT(+$P(RANODE,"^",19),0)),"^",6)\1),"2P") 111 S:RABD="S" RAPIS=RA1 112 S:RABD="E" RAPIS=$P($G(^VA(200,+$P(RANODE,"^",17),0)),"^") 113 S:RAPIS="" RAPIS="Unknown" 114 W !,$E(RAPAT,1,20),?21,$P(RANODE,"^",2),?38,$$FMTE^XLFDT(RAEXDT,"2P"),?48,RACSE,?55,RAPRC,?87,RAXSTAT,?96,RARPTENT,?106,$E(RAPIS,1,25) 115 I $Y>(IOSL-4) S RAOUT=$$EOS^RAUTL5() D:'RAOUT HDR 116 Q 117 ZERO ; set division totals to zero 118 S X="" F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X="" S ^TMP($J,"RAUVR",X)=0 119 Q
Note:
See TracChangeset
for help on using the changeset viewer.
