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

MAGDSTD2.m

Go to the documentation of this file. 
  1. MAGDSTD2 ; OI&T-Clin3/DWM,WOIFO/PMK - rad exams w/o VI images; Jul 06, 2021@08:21:46
  1.  ;;3.0;Support;**231,306**;11/13/2018;Build 1
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+ 
  1.  ;
  1.  ; Supported IA #10026 reference ^DIR subroutine call
  1.  ; Controlled Subscription IA #10035 for Fileman reads of ^DPT
  1.  ; Controlled Subscription IA #1171 to read RAD/NUC MED REPORTS file (#74)
  1.  ; Supported IA #1519 reference EN^XUTMDEVQ subroutine call
  1.  ; Private IA #7111 reference ^RARTFLDS subroutine call
  1.  ; Supported IA #10035 to read PATIENT file (#2)
  1.  ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1.  ; Supported IA #10103 reference $$NOW^XLFDT function call
  1.  ;
  1.  ; Original: MAGWOVI by Dave Massey
  1.  ;
  1. DATES ; enter date range to search
  1.  N DIR,DTFR,DTTO,Y,X
  1.  ;
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
  1.  ;
  1.  W !!!,"Search for Radiology Exams Lacking Images"
  1.  W !,"------------------------------------------"
  1.  D BEGDATE^MAGDSTA2
  1.  S DTFR=$G(^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE"))
  1.  I DTFR="" G EXIT
  1.  D ENDDATE^MAGDSTA2
  1.  S DTTO=$G(^TMP("MAG",$J,"BATCH Q/R","END DATE"))
  1.  I DTTO="" G EXIT
  1.  ;
  1. QUE ; queue to run report
  1.  W !!,"Recommend report output of 132 columns",!!
  1.  ;
  1.  N %ZIS,ZTDESC,ZTSAVE
  1.  S ZTDESC="Radiology Exams w/o VI Images"
  1.  S ZTSAVE("DTFR")=""
  1.  S ZTSAVE("DTTO")=""
  1.  D EN^XUTMDEVQ("EN^"_$T(+0),ZTDESC,.ZTSAVE,.%ZIS)
  1.  G EXIT
  1.  Q
  1.  ;
  1. EN ;entry point
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
  1.  ;
  1.  S X=132 X ^%ZOSF("RM") ; set right margin to 132
  1.  ;
  1.  K ^TMP("MAG",$J)
  1.  ;
  1.  D COUNTS(DTFR,DTTO)
  1.  ;
  1.  ; display results
  1.  I '$D(^TMP("MAG",$J)) W !!,"No data for display!",!! G EXIT
  1.  D DISPLAY
  1.  W !!,"RUN COMPLETED at ",$$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  D CONTINUE^MAGDSTQ
  1.  ;
  1. EXIT ;
  1.  K ^TMP("MAG",$J)
  1.  Q
  1.  ;
  1. COUNTS(DTFR,DTTO) ; build list of exams w/o images
  1.  ;     ^TMP("MAG",$J,LOC,RPTDATE,ACNUMB)=PNAME_"^"_SSN_"^"_PROC
  1.  N RARPT,REVDATE,RPTDATE,XDTFR,XDTTO
  1.  ;
  1.  S XDTFR=DTFR-.0001,XDTTO=DTTO+.9999
  1.  S XDTFR=9999999.9999-XDTFR ; reverse date & time
  1.  S XDTTO=9999999.9999-XDTTO ; reverse date & time
  1.  ;
  1.  S REVDATE=XDTFR
  1.  F  S REVDATE=$O(^RARPT("AA",REVDATE),-1) Q:REVDATE=""  Q:REVDATE<DTTO  D
  1.  . S RPTDATE=9999999.9999-REVDATE ; get regular FM date/time from reverse date/time
  1.  . S RARPT=""
  1.  . F  S RARPT=$O(^RARPT("AA",REVDATE,RARPT))  Q:RARPT=""  D
  1.  . . D LOOKUP(RARPT)
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. LOOKUP(RARPT) ;
  1.  N ACNUMB,DFN,EXAMDATE,FOUND,LOC,RARPT0,OUT,PNAME,PROC,RARPT0,SSN
  1.  S RARPT0=$G(^RARPT(RARPT,0)) I RARPT0="" Q  ; no zero-node
  1.  S ACNUMB=$P(RARPT0,"^",1) I ACNUMB="" Q  ; null accession number
  1.  I $P(RARPT0,"^",5)="X" Q  ; deleted report
  1.  S EXAMDATE=$P(RARPT0,"^",3) ; exam date/time
  1.  ; -- patient demographics --
  1.  S DFN=$P(RARPT0,"^",2) I DFN="" Q  ; null patient field
  1.  S PNAME=$$GET1^DIQ(2,DFN,.01,"E") Q:PNAME=""
  1.  S SSN=$$GET1^DIQ(2,DFN,.09,"E") Q:SSN=""
  1.  ; -- check for #74 file 2005 node --
  1.  ;       if not present, check new sop database
  1.  S FOUND=$$LEGACY(RARPT)
  1.  I 'FOUND D
  1.  . S FOUND=$$NEWSOP(ACNUMB)
  1.  . Q
  1.  I 'FOUND D
  1.  . ; -- lookup report's procedure & imaging location --
  1.  . D PROLOC(.OUT,RARPT) S PROC=$P(OUT,"^",1),LOC=$P(OUT,"^",2)
  1.  . I PROC="" Q  ; no report procedure
  1.  . I LOC="" Q  ; no imaging location 
  1.  . S ^TMP("MAG",$J,LOC,EXAMDATE,ACNUMB)=PNAME_"^"_SSN_"^"_PROC
  1.  . Q
  1.  Q
  1.  ;
  1. LEGACY(RARPT) ; check for "2005" node
  1.  N FOUND,J,MAGIEN
  1.  S (FOUND,J)=0
  1.  ; -- loop #74 "2005" node to validate images --
  1.  F  S J=$O(^RARPT(RARPT,"2005",J)) Q:'J  D
  1.  . S MAGIEN=$G(^RARPT(RARPT,"2005",J,0)) Q:'MAGIEN
  1.  . S FOUND=FOUND+$$CHECKMAG(MAGIEN,RARPT)
  1.  . Q
  1.  Q FOUND
  1.  ;
  1. CHECKMAG(MAGIEN,RARPT) ;
  1.  ; -- ensure #2005 entry exists --
  1.  I '$D(^MAG(2005,MAGIEN,0)) Q 0 ; no entry in file #2005
  1.  ; -- check if image valid --
  1.  I '$$MAG(MAGIEN) Q 0 ; invalid patient or child entry
  1.  ; -- check #2005 pointer back to #74 --
  1.  I '$$PARENT(MAGIEN,RARPT) Q 0 ; bad pointer
  1.  Q 1
  1.  ;
  1. MAG(MAGIEN) ; validate parent or child image
  1.  ; called by ^MAGDSTD3 for consults
  1.  N CHECK,CHILDIEN,J
  1.  S CHECK=0
  1.  ; -- parent #2005 entry --
  1.  I $D(^MAG(2005,MAGIEN,1)) D
  1.  . S J=0 F  S J=$O(^MAG(2005,MAGIEN,1,J)) Q:'J  Q:CHECK  D
  1.  . . S CHILDIEN=$P(^MAG(2005,MAGIEN,1,J,0),"^",1)
  1.  . . Q:'$D(^MAG(2005,CHILDIEN,0))
  1.  . . S CHECK=$$IMAGE(CHILDIEN)
  1.  . . Q
  1.  . Q
  1.  E  D  ; -- child #2005 entry --
  1.  . S CHILDIEN=MAGIEN,CHECK=$$IMAGE(CHILDIEN)
  1.  . Q
  1.  Q CHECK
  1.  ;
  1. IMAGE(CHILDIEN) ; called from within 'MAG' subroutine
  1.  N MAG0,REF,OBJ,TYPE
  1.  S MAG0=$G(^MAG(2005,CHILDIEN,0)) Q:MAG0="" 0
  1.  ; -- file reference and object type
  1.  S REF=$P(MAG0,"^",2),OBJ=$P(MAG0,"^",6)
  1.  Q:REF="" 0 Q:OBJ="" 0
  1.  S TYPE=$P(^MAG(2005.02,OBJ,0),"^",1)
  1.  ;  .dcm, .pdf, & .tga files
  1.  I TYPE="DICOM IMAGE" Q 1
  1.  I TYPE="ADOBE" Q 1 ; for consults
  1.  I TYPE="XRAY" Q 1 ; for old pre-DICOM TGA's
  1.  Q 0
  1.  ;
  1. PARENT(MAGIEN,RARPT) ; check #2005 pointer back to #74
  1.  N REPORT
  1.  I '$D(^MAG(2005,MAGIEN,"PACS")) Q 0
  1.  S REPORT=$P(^MAG(2005,MAGIEN,"PACS"),"^",2)
  1.  I REPORT'=RARPT Q 0
  1.  Q 1
  1.  ;
  1. NEWSOP(GMRCACN) ; lookup in new sop class database
  1.  ; called by ^MAGDSTD3 for consults
  1.  N FIELD,FOUND,FNUM,IEN,IMAGES,J,OUT,OVERRIDE,STATUS
  1.  S FOUND=0
  1.  I $G(GMRCACN)="" Q FOUND
  1.  S OVERRIDE=1
  1.  I '$D(^MAGV(2005.62,"D",GMRCACN)) Q FOUND
  1.  S IEN=0 F  S IEN=$O(^MAGV(2005.62,"D",GMRCACN,IEN)) Q:'IEN  D
  1.  . ;  RPC - MAGV GET STUDY
  1.  . D GETSTUDY^MAGVRS04(.OUT,,IEN,OVERRIDE) Q:'$D(OUT)
  1.  . S J=" " F  S J=$O(OUT(J),-1) Q:'J  Q:FOUND=1  D
  1.  . . S FIELD=$P(OUT(J),"|")
  1.  . . Q:FIELD'="NUMBER OF SOP INSTANCES"
  1.  . . S IMAGES=$P(OUT(J),"|",2)
  1.  . . S:IMAGES>0 FOUND=1
  1.  . . Q
  1.  . Q
  1.  Q FOUND
  1.  ;
  1. PROLOC(OUT,D0) ; return report's procedure & imaging location
  1.  N RACN,RAEXFLD,X,LOC,PROC
  1.  S OUT="^" I D0="" Q
  1.  S RAEXFLD="PROC" D ^RARTFLDS S PROC=X K X Q:PROC=""
  1.  S RAEXFLD="LOC" D ^RARTFLDS S LOC=X K X Q:LOC=""
  1.  S OUT=PROC_"^"_LOC
  1.  Q
  1.  ;
  1. DISPLAY ;
  1.  N ACNUMB,ANS,EXAMDATE,FDATE,LOC,NODE,PNAME,PROC,SSN,STOP,TDATE,X,Y
  1.  S STOP=0,Y=DTFR X ^DD("DD") S FDATE=Y,Y=DTTO X ^DD("DD") S TDATE=Y
  1.  S LOC="" F  S LOC=$O(^TMP("MAG",$J,LOC)) Q:LOC=""  D
  1.  . D HDR I STOP Q
  1.  . S EXAMDATE=0 F  S EXAMDATE=$O(^TMP("MAG",$J,LOC,EXAMDATE)) Q:'EXAMDATE!(STOP=1)  D
  1.  . . S ACNUMB="" F  S ACNUMB=$O(^TMP("MAG",$J,LOC,EXAMDATE,ACNUMB)) Q:ACNUMB=""!(STOP=1)  D
  1.  . . . S NODE=^TMP("MAG",$J,LOC,EXAMDATE,ACNUMB),Y=$P(EXAMDATE,".") X ^DD("DD")
  1.  . . . S PNAME=$P(NODE,"^",1),SSN=$P(NODE,"^",2),PROC=$P(NODE,"^",3)
  1.  . . . W !,ACNUMB,?20,$E(PNAME,1,30),?53,$E(SSN,6,9),?60,Y,?75,PROC
  1.  . . . I $E(IOST,1,2)="C-",$Y+5>IOSL D
  1.  . . . . R !!,"Press RETURN to continue or '^' to exit: ",ANS:DTIME E  S ANS="^"
  1.  . . . . S STOP=$S(ANS="^":1,1:0)
  1.  . . . . W @IOF
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . ; stop after each imaging location displayed
  1.  . I $E(IOST,1,2)="C-" D
  1.  . . R !!,"Press RETURN to continue or '^' to exit: ",ANS:DTIME E  S ANS="^"
  1.  . . S STOP=$S(ANS="^":1,1:0)
  1.  . . Q
  1.  . ; new page after each imaging location displayed
  1.  . W @IOF
  1.  . Q
  1.  Q
  1.  ;
  1. HDR ; header
  1.  N LN,ANS,I
  1.  S LN="-" F I=1:1:131 S LN=LN_"-"
  1.  I $E(IOST,1,2)="C-",$Y+10>IOSL D
  1.  . R !!,"Press RETURN to continue or '^' to exit: ",ANS:DTIME E  S ANS="^"
  1.  . S STOP=$S(ANS="^":1,1:0)
  1.  . W @IOF
  1.  . Q
  1.  I STOP Q
  1.  I $E(IOST,1,2)="C-",$Y>1 W @IOF
  1.  W !,?42,"Radiology Exams without Images in VistA Imaging"
  1.  W !,?93,"From "_FDATE_" to "_TDATE
  1.  W !!,"Imaging Location: "_LOC,!
  1.  W !,"Accession",?20,"Patient Name",?53,"Last4",?60,"Exam Date"
  1.  W ?75,"Procedure",!,LN
  1.  Q