| [613] | 1 | RAPRINT ;HISC/FPT AISC/DMK-Abnormal Exam Report ;8/12/97 09:57
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | ; This report uses the 'AD' cross reference on File 70 to create a
|
|---|
| 5 | ; report of exams that use certain diagnostic codes. The Diagnostic
|
|---|
| 6 | ; Codes file (78.3) has a field named PRINT ON ABNORMAL RPT. If this
|
|---|
| 7 | ; field is set to YES and the user enters that diagnostic code for an
|
|---|
| 8 | ; exam, then an entry is made in the 'AD' cross reference.
|
|---|
| 9 | ;
|
|---|
| 10 | I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
|
|---|
| 11 | W !!,?10,"ABNORMAL EXAM REPORT",!
|
|---|
| 12 | ; Select Imaging Type, if exists
|
|---|
| 13 | S RAXIT=$$SETUPDI^RAUTL7() I RAXIT G END
|
|---|
| 14 | K ^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RADLY")
|
|---|
| 15 | D SELDIV^RAUTL7 ; Select division(s)
|
|---|
| 16 | I '$D(^TMP($J,"RA D-TYPE"))!($G(RAQUIT)) D KILL^RADLY1 G END
|
|---|
| 17 | D SELIMG^RAUTL7 ; Select I-Type(s)
|
|---|
| 18 | I '$D(^TMP($J,"RA I-TYPE"))!($G(RAQUIT)) D KILL^RADLY1 G END
|
|---|
| 19 | S X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
|
|---|
| 20 | . Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=""
|
|---|
| 21 | . F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D
|
|---|
| 22 | .. S:$D(^TMP($J,"RA I-TYPE",Y)) ^TMP($J,"RADLY",X,Y)=0
|
|---|
| 23 | .. Q
|
|---|
| 24 | . Q
|
|---|
| 25 | K ^TMP($J,"RA DX CODES") D OMADX(1)
|
|---|
| 26 | I '$D(^TMP($J,"RA DX CODES")) D D END Q
|
|---|
| 27 | . W !!?3,"No Diagnostic Codes selected, try again later."
|
|---|
| 28 | . Q
|
|---|
| 29 | W !
|
|---|
| 30 | K DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 31 | S DIR(0)="Y",DIR("A")="Print only those exams not yet printed",DIR("B")="Yes",DIR("?")="Enter 'Yes' to print only those exams not yet printed, 'No' to print all." D ^DIR K DIR
|
|---|
| 32 | I $D(DIRUT) D END Q
|
|---|
| 33 | S RASW=$S(+Y=1:0,1:1),ZTRTN="START^RAPRINT",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RASW")="",ZTSAVE("^TMP($J,""RA D-TYPE"",")="",ZTSAVE("^TMP($J,""RA I-TYPE"",")="",ZTSAVE("^TMP($J,""RADLY"",")=""
|
|---|
| 34 | S ZTSAVE("^TMP($J,""RA DX CODES"",")=""
|
|---|
| 35 | D DATE^RAUTL G END:RAPOP S BEGDATE=9999999.9999-BEGDATE,ENDDATE=9999999.9999-ENDDATE
|
|---|
| 36 | W ! D ZIS^RAUTL G:RAPOP END
|
|---|
| 37 | START ;
|
|---|
| 38 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 39 | U IO K I S CNT=0,RAOUT=0,PDATE=+$E(DT,4,5)_"/"_+$E(DT,6,7)_"/"_$E(DT,2,3) S RAEND=ENDDATE-1,QQ="",$P(QQ,"=",80)="=",I1("DIV")="",I1("IT")="",I1("DX")=""
|
|---|
| 40 | D HDR^RAPRINT1 G:RAOUT END
|
|---|
| 41 | F I=0:0 S I=$O(^RADPT("AD",I)) Q:I'>0!(RAOUT) I $D(^RA(78.3,I,0)),($D(^TMP($J,"RA DX CODES",$P(^RA(78.3,I,0),"^")))) F J=0:0 S J=$O(^RADPT("AD",I,J)) Q:J'>0!(RAOUT) F K=RAEND:0 S K=$O(^RADPT("AD",I,J,K)) Q:K'>0!(K>BEGDATE)!(RAOUT) D PAT1
|
|---|
| 42 | D DIV^RAPRINT1,NEGRPT
|
|---|
| 43 | END ;
|
|---|
| 44 | K ^TMP($J),BEGDATE,CNT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,I,I1,J,K,L,PDATE,POP,QQ
|
|---|
| 45 | K RACASE,RADIC,RADFN,RADIAG,RADIVNME,RADIVNUM,RADXCODE,RAEND,RAEXAM,RAEXDT,RAITNAME,RAITNUM,RAMD,RAOUT,RAPAT,RAPATNME,RAPOP,RAPROC,RAQUIT,RASDXDTE,RASDXIEN,RASSN,RASW,RAUTIL,RAWARD,RAXIT,X,Y
|
|---|
| 46 | K POP,ZTRTN,ZTSAVE,RAMES,ZTDESC
|
|---|
| 47 | K:$D(RAPSTX) RACCESS,RAPSTX
|
|---|
| 48 | D CLOSE^RAUTL
|
|---|
| 49 | Q
|
|---|
| 50 | PAT1 F L=0:0 S L=$O(^RADPT("AD",I,J,K,L)) Q:L'>0!(RAOUT) I $D(^RADPT(J,"DT",K,"P",L,0)) D BTG
|
|---|
| 51 | Q
|
|---|
| 52 | BTG ; build tmp global
|
|---|
| 53 | I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
|
|---|
| 54 | S RARE(0)=$G(^RADPT(J,"DT",K,0))
|
|---|
| 55 | S RADIVNUM=+$P(RARE(0),U,3),RADIVNME=$P($G(^DIC(4,RADIVNUM,0)),U)
|
|---|
| 56 | I RADIVNME]"",('$D(^TMP($J,"RA D-TYPE",RADIVNME))) Q
|
|---|
| 57 | S RADIVNME=$S(RADIVNME]"":RADIVNME,1:"Unknown")
|
|---|
| 58 | S RAITNUM=+$P(RARE(0),U,2),RAITNAME=$P($G(^RA(79.2,RAITNUM,0)),U)
|
|---|
| 59 | I RAITNAME]"",('$D(^TMP($J,"RA I-TYPE",RAITNAME))) Q
|
|---|
| 60 | S RAITNAME=$S(RAITNAME]"":RAITNAME,1:"Unknown")
|
|---|
| 61 | K RARE(0)
|
|---|
| 62 | Q:'$D(^TMP($J,"RADLY",RADIVNME,RAITNAME))
|
|---|
| 63 | S RAPATNME=$P($G(^DPT(J,0)),U,1) S:RAPATNME="" RAPATNME="UNKNOWN"
|
|---|
| 64 | S ^TMP($J,RADIVNME,RAITNAME,I,RAPATNME,J,K,L)=""
|
|---|
| 65 | Q
|
|---|
| 66 | NEGRPT ; negative reports
|
|---|
| 67 | Q:+$G(RAOUT)
|
|---|
| 68 | I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
|
|---|
| 69 | S RADIVNME="",RAOUT=0
|
|---|
| 70 | F S RADIVNME=$O(^TMP($J,"RADLY",RADIVNME)) Q:RADIVNME=""!(RAOUT=1) S RAITNAME="" F S RAITNAME=$O(^TMP($J,"RADLY",RADIVNME,RAITNAME)) Q:RAITNAME=""!(RAOUT=1) I +^TMP($J,"RADLY",RADIVNME,RAITNAME)=0 D
|
|---|
| 71 | .D:CNT>0 HANG^RAPRINT1 Q:RAOUT=1
|
|---|
| 72 | .D:CNT>0 HDR^RAPRINT1 Q:RAOUT
|
|---|
| 73 | .W !?22,"Division: ",RADIVNME,!?18,"Imaging Type: ",RAITNAME,!
|
|---|
| 74 | .W !?32,"***********************"
|
|---|
| 75 | .W !?32,"* No Abnormal Exams *"
|
|---|
| 76 | .W !?32,"***********************",!
|
|---|
| 77 | .S CNT=1
|
|---|
| 78 | Q
|
|---|
| 79 | OMADX(RAAB) ; One-Many-All selector for Dx codes.
|
|---|
| 80 | ; Input : RAAB=0 - doesn't need 'Print On Abnormal Rpts' set to 'yes'
|
|---|
| 81 | ; RAAB=1 - must have 'Print On Abnormal Rpts' set to 'yes'
|
|---|
| 82 | N RADIC,RAQUIT,RAUTIL
|
|---|
| 83 | S RADIC="^RA(78.3,",RADIC(0)="QEANZ",RAUTIL="RA DX CODES"
|
|---|
| 84 | S RADIC("A")="Select Diagnostic Codes: ",RADIC("B")="All"
|
|---|
| 85 | S:RAAB RADIC("S")="I $P(^(0),""^"",3)=""Y"""
|
|---|
| 86 | W ! D EN1^RASELCT(.RADIC,RAUTIL)
|
|---|
| 87 | Q
|
|---|
