Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVALERTR

WVALERTR.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to ^DIQ(74 in ICR #2479
  1.  ; Reference to ^DIQ(70 in ICR #2480
  1.  ; Reference to $$GET1^DIQ(78.3,WVPDX_",",.01) in ICR #2484
  1.  ; Reference to $$GET1^DIQ(78.3,WVPDX_",",100) in ICR #2484
  1.  ;
  1. EN(WVIEN,DIAGNS) ; Set up radiology report data
  1.  N WVIENS,WVPDX,WVRPTIEN,WVSECDXS,WVDIANGS
  1.  S WVPDX=""
  1.  D RADCASE(WVIEN,.DIAGNS,.WVIENS,.WVRPTIEN,.WVSECDXS,.WVPDX)
  1.  D RADREP(WVIENS,WVRPTIEN,.WVSECDXS,.WVPDX)
  1.  I $D(WVDIANGS) S DIAGNS("P")=WVDIANGS
  1.  Q
  1.  ;
  1. RADCASE(WVIEN,DIAGNS,WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
  1.  N LOOP,WVDUP,WVERR,WVJCN,WVJCN1,WVLCNT,WVPDXDT,WVPDXNAME,WVRADCSE,WVRADDFN
  1.  N WVRADDTE,WVRADIEN,WVDIANGS
  1.  N CNT,INC,SECDX,TMP
  1.  S WVIENS="",WVPDXDT="",WVPDXNAME=""
  1.  S WVRADIEN=$P(^WV(790.1,WVIEN,0),U,15)
  1.  Q:WVRADIEN=""  ;no 'radiology mam case #'
  1.  I $L(WVRADIEN,"-")>2 S WVRADIEN=$P(WVRADIEN,"-",2,3)
  1.  I '$D(^RADPT("ADC",WVRADIEN)) Q
  1.  S WVRADDFN=$P(^WV(790.1,WVIEN,0),U,2)
  1.  Q:'WVRADDFN  ;no dfn
  1.  I '$D(^RADPT("ADC",WVRADIEN,WVRADDFN)) Q
  1.  S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
  1.  Q:'WVRADDTE  ;no inverse exam date
  1.  S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
  1.  Q:'WVRADCSE  ;no case number
  1.  S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
  1.  Q:'WVRPTIEN  ;no report in File 74
  1.  S WVPDX=+$P($G(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0)),U,13)
  1.  I WVPDX>0 D
  1.  .S WVPDXNAME=$$GET1^DIQ(78.3,WVPDX_",",.01)
  1.  .S WVPDXDT=$$GET1^DIQ(78.3,WVPDX_",",100)
  1.  .I WVPDXNAME="" S WVPDX="" Q
  1.  .S WVPDX=WVPDXNAME_$S(WVPDXDT'="":" "_WVPDXDT,1:"")
  1.  S CNT=0,INC=0 F  S CNT=$O(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT)) Q:CNT'>0  D
  1.  .S TMP=+$G(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,"DX",CNT,0)) I TMP'>0 Q
  1.  .S SECDX=$$GET1^DIQ(78.3,TMP_",",.01) I SECDX="" Q
  1.  .S WVSECDXS(SECDX)=""
  1.  .S INC=INC+1,DIAGNS("S",INC)=SECDX
  1.  S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
  1.  Q
  1.  ;
  1. RADREP(WVIENS,WVRPTIEN,WVSECDXS,WVPDX) ;
  1.  K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
  1.  ; get clinical history from FILE 70
  1.  I $G(WVIENS)="" D  Q
  1.  .S ^TMP("WV RPT",$J,1,0)="The radiology report text is not available."
  1.  .S ^TMP("WV RPT",$J,2,0)="Please review the imaging report on the reports tab or contact the radiology department."
  1.  D GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")","WVERR")
  1.  ; get data from FILE 74
  1.  K WVERR
  1.  D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RPT"")","WVERR")
  1.  N CNT,FIRST,WVSECDX
  1.  S CNT=0
  1.  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:"")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="               EXAM DATE/TIME: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",3,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="          VERIFYING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",9,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="                    PROCEDURE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",102,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="             CATEGORY OF EXAM: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",104,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="                         WARD: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",106,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RPT",74,WVRPTIEN_",",107,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="             PRINCIPAL CLINIC: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",108,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="      CONTRACT SHARING SOURCE: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",109,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",112,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="   PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",115,"E")
  1.  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"))
  1.  S WVDIANGS=^TMP($J,"WV RPT",74,WVRPTIEN_",",113,"E")
  1.  I $D(WVSECDXS) D
  1.  .S FIRST=1,WVSECDX=""
  1.  .F  S WVSECDX=$O(WVSECDXS(WVSECDX)) Q:WVSECDX=""  D
  1.  ..I FIRST=1 S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="          SECONDARY DIAGNOSIS: "_WVSECDX,FIRST=0 Q
  1.  ..S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="                               "_WVSECDX
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="         REQUESTING PHYSICIAN: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",114,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="                 COMPLICATION: "_^TMP($J,"WV RPT",74,WVRPTIEN_",",116,"E")
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)=" "
  1.  S CNT=CNT+1,^TMP("WV RPT",$J,CNT,0)="CLINICAL HISTORY:"
  1.  S LOOP=0
  1.  ;WVLCNT=CNT
  1.  S WVDUP=$$COMPARE()
  1.  I WVDUP=1 D  ;Clinical History text in files 70 & 74 are different
  1.  .S LOOP=0
  1.  .F  S LOOP=$O(^TMP($J,"WV CH",70.03,WVIENS,400,LOOP)) Q:'LOOP  D
  1.  ..S CNT=CNT+1
  1.  ..S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
  1.  ..Q
  1.  .;I WVLCNT>16 D  ;insert blank line if different texts exist
  1.  .S CNT=CNT+1
  1.  .S ^TMP("WV RPT",$J,CNT,0)=" "
  1.  .;.Q
  1.  .S LOOP=0
  1.  .F  S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP  D
  1.  ..S CNT=CNT+1
  1.  ..S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
  1.  ..Q
  1.  .Q
  1.  I WVDUP=0 D  ;Clinical History field is same
  1.  .S LOOP=0
  1.  .F  S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP  D
  1.  ..S CNT=CNT+1
  1.  ..S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",400,LOOP)
  1.  ..Q
  1.  .Q
  1.  S CNT=CNT+1
  1.  S ^TMP("WV RPT",$J,CNT,0)=" "
  1.  S CNT=CNT+1
  1.  S ^TMP("WV RPT",$J,CNT,0)="IMPRESSION TEXT:"
  1.  S LOOP=0
  1.  F  S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP  D
  1.  .S CNT=CNT+1
  1.  .S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",300,LOOP)
  1.  .Q
  1.  S CNT=CNT+1
  1.  S ^TMP("WV RPT",$J,CNT,0)=" "
  1.  S CNT=CNT+1
  1.  S ^TMP("WV RPT",$J,CNT,0)="REPORT TEXT:"
  1.  S LOOP=0
  1.  F  S LOOP=$O(^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP  D
  1.  .S CNT=CNT+1
  1.  .S ^TMP("WV RPT",$J,CNT,0)=^TMP($J,"WV RPT",74,WVRPTIEN_",",200,LOOP)
  1.  .Q
  1.  K ^TMP($J,"WV RPT"),^TMP($J,"WV CH")
  1.  Q
  1. AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
  1.  ; WVRPTIEN - File 74 ien
  1.  N WVAMEND
  1.  K ^TMP("DILIST",$J),^TMP("DIERR",$J)
  1.  D LIST^DIC(74.06,","_WVRPTIEN_",",.01)
  1.  S WVAMEND=$O(^TMP("DILIST",$J,0))
  1.  K ^TMP("DILIST",$J),^TMP("DIERR",$J)
  1.  Q WVAMEND
  1.  ;
  1. COMPARE() ; Compares Clinical History fields in files 70 & 74
  1.  ; Returns 1 (different) or 0 (same)
  1.  N LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
  1.  S (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
  1.  S WV70IEN=WVIENS,WV74IEN=WVRPTIEN_","
  1.  I '$O(^TMP($J,"WV CH",70.03,WV70IEN,400,0)) S WVFLAG=WVFLAG+1
  1.  I '$O(^TMP($J,"WV RPT",74,WV74IEN,400,0)) S WVFLAG=WVFLAG+1
  1.  I WVFLAG=1 Q 1  ;different (field was purged in one file, exists in
  1.  ;                the other file)
  1.  I WVFLAG=2 Q 0  ;same (field was purged in 70 & 74)
  1.  F  S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP  D
  1.  .S WV70CNT=WV70CNT+1
  1.  .Q
  1.  S LOOP=0
  1.  F  S LOOP=$O(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP)) Q:'LOOP  D
  1.  .S WV74CNT=WV74CNT+1
  1.  .Q
  1.  I WV70CNT'=WV74CNT Q 1  ;line counts are different
  1.  S LOOP=0
  1.  F  S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP!(WVFLAG=1)  D
  1.  .S WVNODE70=$G(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP,0))
  1.  .S WVNODE74=$G(^TMP($J,"WV RPT",74,WV74IEN,400,LOOP))
  1.  .I WVNODE70'=WVNODE74 S WVFLAG=1
  1.  .Q
  1.  Q WVFLAG
  1.  ;