124 lines
5.3 KiB
Mathematica
124 lines
5.3 KiB
Mathematica
WVALERTR ;HIOFO/FT-RETURN RADIOLOGY/NM REPORT IN TMP GLOBAL ;1/2/04 11:09
|
|
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
|
|
;
|
|
; This routine uses the following IAs:
|
|
; #2479 - FILE 74 fields (private)
|
|
; #2480 - FILE 70 fields (private)
|
|
;
|
|
EN ; Set up radiology report data
|
|
N LOOP,WVDUP,WVERR,WVIENS,WVJCN,WVJCN1,WVLCNT,WVRADCSE,WVRADDFN
|
|
N WVRADDTE,WVRADIEN,WVRPTIEN
|
|
S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
|
|
Q:WVRADIEN="" ;no 'radiology mam case #'
|
|
S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
|
|
Q:'WVRADDFN ;no dfn
|
|
S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
|
|
Q:'WVRADDTE ;no inverse exam date
|
|
S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
|
|
Q:'WVRADCSE ;no case number
|
|
S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
|
|
Q:'WVRPTIEN ;no report in File 74
|
|
K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
|
|
S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
|
|
; get clincal history from FILE 70
|
|
D GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")","WVERR")
|
|
; get data from FILE 74
|
|
K WVERR
|
|
D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
|
|
S ^TMP("WV RPT",$J,1,0)=" DAY-CASE #: "_$G(^TMP($J,"WV RPT",74,WVRPTIEN_",",.01,"E"))_$S($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
|
|
S ^TMP("WV RPT",$J,2,0)=" EXAM DATE/TIME: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",3,"E")
|
|
S ^TMP("WV RPT",$J,3,0)=" VERIFYING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",9,"E")
|
|
S ^TMP("WV RPT",$J,4,0)=" PROCEDURE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
|
|
S ^TMP("WV RPT",$J,5,0)=" CATEGORY OF EXAM: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",104,"E")
|
|
S ^TMP("WV RPT",$J,6,0)=" WARD: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",106,"E")
|
|
S ^TMP("WV RPT",$J,7,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RPT",74,WVRPTIEN_",",107,"E")
|
|
S ^TMP("WV RPT",$J,8,0)=" PRINCIPAL CLINIC: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",108,"E")
|
|
S ^TMP("WV RPT",$J,9,0)=" CONTRACT SHARING SOURCE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",109,"E")
|
|
S ^TMP("WV RPT",$J,10,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",112,"E")
|
|
S ^TMP("WV RPT",$J,11,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",115,"E")
|
|
S ^TMP("WV RPT",$J,12,0)=" PRIMARY DIAGNOSIS: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
|
|
S ^TMP("WV RPT",$J,13,0)=" REQUESTING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",114,"E")
|
|
S ^TMP("WV RPT",$J,14,0)=" COMPLICATION: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",116,"E")
|
|
S ^TMP("WV RPT",$J,15,0)=" "
|
|
S ^TMP("WV RPT",$J,16,0)="CLINICAL HISTORY:"
|
|
S LOOP=0,WVLCNT=16
|
|
S WVDUP=$$COMPARE()
|
|
I WVDUP=1 D ;Clinical History text in files 70 & 74 are different
|
|
.S LOOP=0
|
|
.F S LOOP=$O(^TMP($J,"WV CH",70.03,WVIENS,400,LOOP)) Q:'LOOP D
|
|
..S WVLCNT=WVLCNT+1
|
|
..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
|
|
..Q
|
|
.I WVLCNT>16 D ;insert blank line if different texts exist
|
|
..S WVLCNT=WVLCNT+1
|
|
..S ^TMP("WV RPT",$J,WVLCNT,0)=" "
|
|
..Q
|
|
.S LOOP=0
|
|
.F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
|
|
..S WVLCNT=WVLCNT+1
|
|
..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
|
|
..Q
|
|
.Q
|
|
I WVDUP=0 D ;Clinical History field is same
|
|
.S LOOP=0
|
|
.F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
|
|
..S WVLCNT=WVLCNT+1
|
|
..S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
|
|
..Q
|
|
.Q
|
|
S WVLCNT=WVLCNT+1
|
|
S ^TMP("WV RPT",$J,WVLCNT,0)=" "
|
|
S WVLCNT=WVLCNT+1
|
|
S ^TMP("WV RPT",$J,WVLCNT,0)="IMPRESSION TEXT:"
|
|
S LOOP=0
|
|
F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP D
|
|
.S WVLCNT=WVLCNT+1
|
|
.S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)
|
|
.Q
|
|
S WVLCNT=WVLCNT+1
|
|
S ^TMP("WV RPT",$J,WVLCNT,0)=" "
|
|
S WVLCNT=WVLCNT+1
|
|
S ^TMP("WV RPT",$J,WVLCNT,0)="REPORT TEXT:"
|
|
S LOOP=0
|
|
F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP D
|
|
.S WVLCNT=WVLCNT+1
|
|
.S ^TMP("WV RPT",$J,WVLCNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)
|
|
.Q
|
|
K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
|
|
Q
|
|
AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
|
|
; WVRPTIEN - File 74 ien
|
|
N WVAMEND
|
|
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
|
|
D LIST^DIC(74.06,","_WVRPTIEN_",",.01)
|
|
S WVAMEND=$O(^TMP("DILIST",$J,0))
|
|
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
|
|
Q WVAMEND
|
|
;
|
|
COMPARE() ; Compares Clincal History fields in files 70 & 74
|
|
; Returns 1 (different) or 0 (same)
|
|
N LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
|
|
S (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
|
|
S WV70IEN=WVIENS,WV74IEN=WVRPTIEN_","
|
|
I '$O(^TMP($J,"WV CH",70.03,WV70IEN,400,0)) S WVFLAG=WVFLAG+1
|
|
I '$O(^TMP($J,"WV RPT",74,WV74IEN,400,0)) S WVFLAG=WVFLAG+1
|
|
I WVFLAG=1 Q 1 ;different (field was purged in one file, exists in
|
|
; the other file)
|
|
I WVFLAG=2 Q 0 ;same (field was purged in 70 & 74)
|
|
F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP D
|
|
.S WV70CNT=WV70CNT+1
|
|
.Q
|
|
S LOOP=0
|
|
F S LOOP=$O(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP)) Q:'LOOP D
|
|
.S WV74CNT=WV74CNT+1
|
|
.Q
|
|
I WV70CNT'=WV74CNT Q 1 ;line counts are different
|
|
S LOOP=0
|
|
F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP!(WVFLAG=1) D
|
|
.S WVNODE70=$G(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP,0))
|
|
.S WVNODE74=$G(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP))
|
|
.I WVNODE70'=WVNODE74 S WVFLAG=1
|
|
.Q
|
|
Q WVFLAG
|
|
;
|