WVALERTR ;HIOFO/FT - RETURN RADIOLOGY/NM REPORT IN TMP GLOBAL;Oct 24, 2023@15:19:39
;;1.0;WOMEN'S HEALTH;**16,24,26,28,32**;Sep 30, 1998;Build 7
;
; Reference to ^DIQ(74 in ICR #2479
; Reference to ^DIQ(70 in ICR #2480
; Reference to $$GET1^DIQ(78.3,WVPDX_",",.01) in ICR #2484
; Reference to $$GET1^DIQ(78.3,WVPDX_",",100) in ICR #2484
;
EN(WVIEN,DIAGNS) ; Set up radiology report data
N WVIENS,WVPDX,WVRPTIEN,WVSECDXS,WVDIANGS
S WVPDX=""
D RADCASE(WVIEN,.DIAGNS,.WVIENS,.WVRPTIEN,.WVSECDXS,.WVPDX)
D RADREP(WVIENS,WVRPTIEN,.WVSECDXS,.WVPDX)
I $D(WVDIANGS) S DIAGNS("P")=WVDIANGS
Q
;
RADCASE(WVIEN,DIAGNS,WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
N LOOP,WVDUP,WVERR,WVJCN,WVJCN1,WVLCNT,WVPDXDT,WVPDXNAME,WVRADCSE,WVRADDFN
N WVRADDTE,WVRADIEN,WVDIANGS
N CNT,INC,SECDX,TMP
S WVIENS="",WVPDXDT="",WVPDXNAME=""
S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
Q:WVRADIEN="" ;no 'radiology mam case #'
I $L(WVRADIEN,"-")>2 S WVRADIEN=$P(WVRADIEN,"-",2,3)
I '$D(^RADPT("ADC",WVRADIEN)) Q
S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
Q:'WVRADDFN ;no dfn
I '$D(^RADPT("ADC",WVRADIEN,WVRADDFN)) Q
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
S WVPDX=+$P($G(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0)),U,13)
I WVPDX>0 D
.S WVPDXNAME=$$GET1^DIQ(78.3,WVPDX_",",.01)
.S WVPDXDT=$$GET1^DIQ(78.3,WVPDX_",",100)
.I WVPDXNAME="" S WVPDX="" Q
.S WVPDX=WVPDXNAME_$S(WVPDXDT'="":" "_WVPDXDT,1:"")
S CNT=0,INC=0 F S CNT=$O(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT)) Q:CNT'>0 D
.S TMP=+$G(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT,0)) I TMP'>0 Q
.S SECDX=$$GET1^DIQ(78.3,TMP_",",.01) I SECDX="" Q
.S WVSECDXS(SECDX)=""
.S INC=INC+1,DIAGNS("S",INC)=SECDX
S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
Q
;
RADREP(WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
; get clinical history from FILE 70
I $G(WVIENS)="" D Q
.S ^TMP("WV RPT",$J,1,0)="The radiology report text is not available."
.S ^TMP("WV RPT",$J,2,0)="Please review the imaging report on the reports tab or contact the radiology department."
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")
N CNT,FIRST,WVSECDX
S CNT=0
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" DAY-CASE #: "_$G(^TMP($J,"WV RPT",74,WVRPTIEN_",",.01,"E"))_$S($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" EXAM DATE/TIME: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",3,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" VERIFYING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",9,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" PROCEDURE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" CATEGORY OF EXAM: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",104,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" WARD: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",106,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RPT",74,WVRPTIEN_",",107,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" PRINCIPAL CLINIC: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",108,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" CONTRACT SHARING SOURCE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",109,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",112,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",115,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" PRIMARY DIAGNOSIS: "_$S($G(WVPDX)'="":WVPDX,1:^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E"))
S WVDIANGS=^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
I $D(WVSECDXS) D
.S FIRST=1,WVSECDX=""
.F S WVSECDX=$O(WVSECDXS(WVSECDX)) Q:WVSECDX="" D
..I FIRST=1 S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" SECONDARY DIAGNOSIS: "_WVSECDX,FIRST=0 Q
..S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" "_WVSECDX
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" REQUESTING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",114,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" COMPLICATION: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",116,"E")
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" "
S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="CLINICAL HISTORY:"
S LOOP=0
;WVLCNT=CNT
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 CNT=CNT+1
..S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
..Q
.;I WVLCNT>16 D ;insert blank line if different texts exist
.S CNT=CNT+1
.S ^TMP("WV RPT",$J,CNT,0)=" "
.;.Q
.S LOOP=0
.F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
..S CNT=CNT+1
..S ^TMP("WV RPT",$J,CNT,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 CNT=CNT+1
..S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
..Q
.Q
S CNT=CNT+1
S ^TMP("WV RPT",$J,CNT,0)=" "
S CNT=CNT+1
S ^TMP("WV RPT",$J,CNT,0)="IMPRESSION TEXT:"
S LOOP=0
F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP D
.S CNT=CNT+1
.S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)
.Q
S CNT=CNT+1
S ^TMP("WV RPT",$J,CNT,0)=" "
S CNT=CNT+1
S ^TMP("WV RPT",$J,CNT,0)="REPORT TEXT:"
S LOOP=0
F S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP D
.S CNT=CNT+1
.S ^TMP("WV RPT",$J,CNT,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 Clinical 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVALERTR 7415 printed Dec 13, 2024@02:46:40 Page 2
WVALERTR ;HIOFO/FT - RETURN RADIOLOGY/NM REPORT IN TMP GLOBAL;Oct 24, 2023@15:19:39
+1 ;;1.0;WOMEN'S HEALTH;**16,24,26,28,32**;Sep 30, 1998;Build 7
+2 ;
+3 ; Reference to ^DIQ(74 in ICR #2479
+4 ; Reference to ^DIQ(70 in ICR #2480
+5 ; Reference to $$GET1^DIQ(78.3,WVPDX_",",.01) in ICR #2484
+6 ; Reference to $$GET1^DIQ(78.3,WVPDX_",",100) in ICR #2484
+7 ;
EN(WVIEN,DIAGNS) ; Set up radiology report data
+1 NEW WVIENS,WVPDX,WVRPTIEN,WVSECDXS,WVDIANGS
+2 SET WVPDX=""
+3 DO RADCASE(WVIEN,.DIAGNS,.WVIENS,.WVRPTIEN,.WVSECDXS,.WVPDX)
+4 DO RADREP(WVIENS,WVRPTIEN,.WVSECDXS,.WVPDX)
+5 IF $DATA(WVDIANGS)
SET DIAGNS("P")=WVDIANGS
+6 QUIT
+7 ;
RADCASE(WVIEN,DIAGNS,WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
+1 NEW LOOP,WVDUP,WVERR,WVJCN,WVJCN1,WVLCNT,WVPDXDT,WVPDXNAME,WVRADCSE,WVRADDFN
+2 NEW WVRADDTE,WVRADIEN,WVDIANGS
+3 NEW CNT,INC,SECDX,TMP
+4 SET WVIENS=""
SET WVPDXDT=""
SET WVPDXNAME=""
+5 SET WVRADIEN=$PIECE(^WV(790.1,WVIEN,0),U,15)
+6 ;no 'radiology mam case #'
if WVRADIEN=""
QUIT
+7 IF $LENGTH(WVRADIEN,"-")>2
SET WVRADIEN=$PIECE(WVRADIEN,"-",2,3)
+8 IF '$DATA(^RADPT("ADC",WVRADIEN))
QUIT
+9 SET WVRADDFN=$PIECE(^WV(790.1,WVIEN,0),U,2)
+10 ;no dfn
if 'WVRADDFN
QUIT
+11 IF '$DATA(^RADPT("ADC",WVRADIEN,WVRADDFN))
QUIT
+12 SET WVRADDTE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
+13 ;no inverse exam date
if 'WVRADDTE
QUIT
+14 SET WVRADCSE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
+15 ;no case number
if 'WVRADCSE
QUIT
+16 SET WVRPTIEN=+$PIECE(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
+17 ;no report in File 74
if 'WVRPTIEN
QUIT
+18 SET WVPDX=+$PIECE($GET(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0)),U,13)
+19 IF WVPDX>0
Begin DoDot:1
+20 SET WVPDXNAME=$$GET1^DIQ(78.3,WVPDX_",",.01)
+21 SET WVPDXDT=$$GET1^DIQ(78.3,WVPDX_",",100)
+22 IF WVPDXNAME=""
SET WVPDX=""
QUIT
+23 SET WVPDX=WVPDXNAME_$SELECT(WVPDXDT'="":" "_WVPDXDT,1:"")
End DoDot:1
+24 SET CNT=0
SET INC=0
FOR
SET CNT=$ORDER(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT))
if CNT'>0
QUIT
Begin DoDot:1
+25 SET TMP=+$GET(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT,0))
IF TMP'>0
QUIT
+26 SET SECDX=$$GET1^DIQ(78.3,TMP_",",.01)
IF SECDX=""
QUIT
+27 SET WVSECDXS(SECDX)=""
+28 SET INC=INC+1
SET DIAGNS("S",INC)=SECDX
End DoDot:1
+29 ;iens for FILE 70 entry
SET WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_","
+30 QUIT
+31 ;
RADREP(WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
+1 KILL ^TMP($JOB,"WV RPT"),^TMP($JOB,"WV CH")
+2 ; get clinical history from FILE 70
+3 IF $GET(WVIENS)=""
Begin DoDot:1
+4 SET ^TMP("WV RPT",$JOB,1,0)="The radiology report text is not available."
+5 SET ^TMP("WV RPT",$JOB,2,0)="Please review the imaging report on the reports tab or contact the radiology department."
End DoDot:1
QUIT
+6 DO GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")","WVERR")
+7 ; get data from FILE 74
+8 KILL WVERR
+9 DO GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
+10 NEW CNT,FIRST,WVSECDX
+11 SET CNT=0
+12 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" DAY-CASE #: "_$GET(^TMP($JOB,"WV RPT",74,WVRPTIEN_",",.01,"E"))_$SELECT($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
+13 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" EXAM DATE/TIME: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",3,"E")
+14 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" VERIFYING PHYSICIAN: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",9,"E")
+15 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" PROCEDURE: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",102,"E")
+16 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" CATEGORY OF EXAM: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",104,"E")
+17 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" WARD: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",106,"E")
+18 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" TREATING SERVICE (INPATIENT): "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",107,"E")
+19 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" PRINCIPAL CLINIC: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",108,"E")
+20 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" CONTRACT SHARING SOURCE: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",109,"E")
+21 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",112,"E")
+22 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",115,"E")
+23 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" PRIMARY DIAGNOSIS: "_$SELECT($GET(WVPDX)'="":WVPDX,1:^TMP($JOB,"WV RPT",74,WVRPTIEN_",",113,"E"))
+24 SET WVDIANGS=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",113,"E")
+25 IF $DATA(WVSECDXS)
Begin DoDot:1
+26 SET FIRST=1
SET WVSECDX=""
+27 FOR
SET WVSECDX=$ORDER(WVSECDXS(WVSECDX))
if WVSECDX=""
QUIT
Begin DoDot:2
+28 IF FIRST=1
SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" SECONDARY DIAGNOSIS: "_WVSECDX
SET FIRST=0
QUIT
+29 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" "_WVSECDX
End DoDot:2
End DoDot:1
+30 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" REQUESTING PHYSICIAN: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",114,"E")
+31 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" COMPLICATION: "_^TMP($JOB,"WV RPT",74,WVRPTIEN_",",116,"E")
+32 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)=" "
+33 SET CNT=CNT+1
SET ^TMP("WV RPT",$JOB,CNT,0)="CLINICAL HISTORY:"
+34 SET LOOP=0
+35 ;WVLCNT=CNT
+36 SET WVDUP=$$COMPARE()
+37 ;Clinical History text in files 70 & 74 are different
IF WVDUP=1
Begin DoDot:1
+38 SET LOOP=0
+39 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WVIENS,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+40 SET CNT=CNT+1
+41 SET ^TMP("WV RPT",$JOB,CNT,0)=^TMP($JOB,"WV CH",70.03,WVIENS,400,LOOP,0)
+42 QUIT
End DoDot:2
+43 ;I WVLCNT>16 D ;insert blank line if different texts exist
+44 SET CNT=CNT+1
+45 SET ^TMP("WV RPT",$JOB,CNT,0)=" "
+46 ;.Q
+47 SET LOOP=0
+48 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RPT",74,WVRPTIEN_",",400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+49 SET CNT=CNT+1
+50 SET ^TMP("WV RPT",$JOB,CNT,0)=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",400,LOOP)
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 ;Clinical History field is same
IF WVDUP=0
Begin DoDot:1
+54 SET LOOP=0
+55 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RPT",74,WVRPTIEN_",",400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+56 SET CNT=CNT+1
+57 SET ^TMP("WV RPT",$JOB,CNT,0)=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",400,LOOP)
+58 QUIT
End DoDot:2
+59 QUIT
End DoDot:1
+60 SET CNT=CNT+1
+61 SET ^TMP("WV RPT",$JOB,CNT,0)=" "
+62 SET CNT=CNT+1
+63 SET ^TMP("WV RPT",$JOB,CNT,0)="IMPRESSION TEXT:"
+64 SET LOOP=0
+65 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RPT",74,WVRPTIEN_",",300,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+66 SET CNT=CNT+1
+67 SET ^TMP("WV RPT",$JOB,CNT,0)=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",300,LOOP)
+68 QUIT
End DoDot:1
+69 SET CNT=CNT+1
+70 SET ^TMP("WV RPT",$JOB,CNT,0)=" "
+71 SET CNT=CNT+1
+72 SET ^TMP("WV RPT",$JOB,CNT,0)="REPORT TEXT:"
+73 SET LOOP=0
+74 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RPT",74,WVRPTIEN_",",200,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+75 SET CNT=CNT+1
+76 SET ^TMP("WV RPT",$JOB,CNT,0)=^TMP($JOB,"WV RPT",74,WVRPTIEN_",",200,LOOP)
+77 QUIT
End DoDot:1
+78 KILL ^TMP($JOB,"WV RPT"),^TMP($JOB,"WV CH")
+79 QUIT
AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
+1 ; WVRPTIEN - File 74 ien
+2 NEW WVAMEND
+3 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+4 DO LIST^DIC(74.06,","_WVRPTIEN_",",.01)
+5 SET WVAMEND=$ORDER(^TMP("DILIST",$JOB,0))
+6 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+7 QUIT WVAMEND
+8 ;
COMPARE() ; Compares Clinical History fields in files 70 & 74
+1 ; Returns 1 (different) or 0 (same)
+2 NEW LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
+3 SET (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
+4 SET WV70IEN=WVIENS
SET WV74IEN=WVRPTIEN_","
+5 IF '$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,0))
SET WVFLAG=WVFLAG+1
+6 IF '$ORDER(^TMP($JOB,"WV RPT",74,WV74IEN,400,0))
SET WVFLAG=WVFLAG+1
+7 ;different (field was purged in one file, exists in
IF WVFLAG=1
QUIT 1
+8 ; the other file)
+9 ;same (field was purged in 70 & 74)
IF WVFLAG=2
QUIT 0
+10 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+11 SET WV70CNT=WV70CNT+1
+12 QUIT
End DoDot:1
+13 SET LOOP=0
+14 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RPT",74,WV74IEN,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+15 SET WV74CNT=WV74CNT+1
+16 QUIT
End DoDot:1
+17 ;line counts are different
IF WV70CNT'=WV74CNT
QUIT 1
+18 SET LOOP=0
+19 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP))
if 'LOOP!(WVFLAG=1)
QUIT
Begin DoDot:1
+20 SET WVNODE70=$GET(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP,0))
+21 SET WVNODE74=$GET(^TMP($JOB,"WV RPT",74,WV74IEN,400,LOOP))
+22 IF WVNODE70'=WVNODE74
SET WVFLAG=1
+23 QUIT
End DoDot:1
+24 QUIT WVFLAG
+25 ;
