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

MAGDSTD3.m

Go to the documentation of this file.
  1. MAGDSTD3 ; OI&T-Clin3/DWM,WOIFO/PMK - rad exams w/o VI images; Jul 06, 2021@08:27:03
  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 #2056 reference $$GET1^DIQ function call;
  1. ; Controlled Subscription IA #10035 for Fileman reads of ^DPT
  1. ; Supported IA #10026 reference ^DIR subroutine call
  1. ; Supported IA #1519 reference EN^XUTMDEVQ subroutine call
  1. ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
  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. ; This is the CONSULT version of MAGDSTD2
  1. ;
  1. DATES ; enter date range to search
  1. N CONSULTSERVICES,DIR,DTFR,DTTO,SERVICE,Y,X
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERROR^MAGDSTA"
  1. ;
  1. ;
  1. W !!!,"Search for Clinical Specialty 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. W ! S X=$$SERVICES^MAGDSTA8(.CONSULTSERVICES)
  1. I X<0 W !,"Exiting" Q
  1. ;
  1. QUE ; queue to run report
  1. W !!,"Recommend report output of 132 columns",!!
  1. ;
  1. N %ZIS,ZTDESC,ZTSAVE
  1. S ZTDESC="Clinical Specialty Exams w/o VI Images"
  1. S ZTSAVE("DTFR")=""
  1. S ZTSAVE("DTTO")=""
  1. S ZTSAVE("CONSULTSERVICES(")=""
  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. S SERVICE="" F S SERVICE=$O(CONSULTSERVICES(SERVICE)) Q:SERVICE="" D
  1. . D COUNTS(DTFR,DTTO,.SERVICE)
  1. . Q
  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,SERVICE) ; build list of exams w/o images
  1. ; ^TMP("MAG",$J,SERVICE,EXAMDATE,ACNUMB)=PNAME_"^"_SSN_"^"_PROC
  1. N COMPLETE,EXAMDATE,GMRCIEN,REVDATE,XDTFR,XDTTO
  1. ;
  1. S XDTFR=DTFR-.0001,XDTTO=DTTO+.9999
  1. ; S XDTFR=9999999.9999-XDTFR ; reverse date & time
  1. S XDTFR=$$GMRCDATE^MAGDSTA7(XDTFR) ; reverse date & time
  1. ; S XDTTO=9999999.9999-XDTTO ; reverse date & time
  1. S XDTTO=$$GMRCDATE^MAGDSTA7(XDTTO) ; reverse date & time
  1. ;
  1. ; search completed consult/procedure request
  1. S COMPLETE=2 ; ORDER STATUS file (#100.01) COMPLETE status
  1. S REVDATE=XDTFR
  1. F S REVDATE=$O(^GMR(123,"AE",SERVICE,COMPLETE,REVDATE),-1) Q:REVDATE="" Q:REVDATE<DTTO D
  1. . S EXAMDATE=9999999.9999-REVDATE ; get regular FM date/time from reverse date/time
  1. . S GMRCIEN=""
  1. . F S GMRCIEN=$O(^GMR(123,"AE",SERVICE,COMPLETE,REVDATE,GMRCIEN)) Q:GMRCIEN="" D
  1. . . D LOOKUP(GMRCIEN)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. LOOKUP(GMRCIEN) ;
  1. N DFN,GMRCACN,FOUND,PNAME,PROC,SENDIT,SSN
  1. S DFN=$$GET1^DIQ(123,GMRCIEN,.02,"I") Q:DFN=""
  1. S PNAME=$$GET1^DIQ(2,DFN,.01,"E") Q:PNAME=""
  1. S SSN=$$GET1^DIQ(2,DFN,.09,"E") Q:SSN=""
  1. ;
  1. ; check if the consult is supported by a DICOM modality worklist
  1. I '$$SERVICE^MAGDHOW1(SERVICE,GMRCIEN) Q ; no worklist defined
  1. ;
  1. ; worklist defined - check if the consult/procedure has images
  1. ;
  1. S GMRCACN=$$GMRCACN^MAGDFCNV(GMRCIEN)
  1. S FOUND=$$LEGACY(GMRCIEN) ; lookup in legacy database
  1. I 'FOUND D
  1. . S FOUND=$$NEWSOP^MAGDSTD2(GMRCACN) ; lookup in new sop class database
  1. . Q
  1. I 'FOUND D ; image(s) not found (or maybe incorrect)
  1. . S PROC=$$GET1^DIQ(123,GMRCIEN,4,"E") I PROC="" S PROC="CONSULT"
  1. . S ^TMP("MAG",$J,CONSULTSERVICES(SERVICE),EXAMDATE,GMRCACN)=PNAME_"^"_SSN_"^"_PROC
  1. . Q
  1. Q
  1. ;
  1. LEGACY(GMRCIEN) ; lookup in legacy database
  1. N FOUND,I,MAGIEN,TIU892591,TIU91NODE,TIUIEN,TIUNODE
  1. S (FOUND,I)=0
  1. F S I=$O(^GMR(123,GMRCIEN,50,I)) Q:'I D
  1. . S TIUNODE=$G(^GMR(123,GMRCIEN,50,I,0))
  1. . I $P(TIUNODE,";",2)="TIU(8925," S TIUIEN=$P(TIUNODE,";",1) D
  1. . . Q:'TIUIEN
  1. . . S TIU892591=""
  1. . . F S TIU892591=$O(^TIU(8925.91,"B",TIUIEN,TIU892591)) Q:'TIU892591 D
  1. . . . S TIU91NODE=^TIU(8925.91,TIU892591,0),MAGIEN=$P(TIU91NODE,"^",2)
  1. . . . I MAGIEN S FOUND=FOUND+$$CHECKMAG(MAGIEN,TIUIEN,TIU892591)
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q FOUND
  1. ;
  1. CHECKMAG(MAGIEN,TIUIEN,TIU892591) ;
  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^MAGDSTD2(MAGIEN) Q 0 ; invalid patient or child entry
  1. ; -- check #2005 pointer back to #8925.91 --
  1. I '$$PARENT(MAGIEN,TIUIEN,TIU892591) Q 0 ; bad pointer
  1. Q 1
  1. ;
  1. PARENT(MAGIEN,TIUIEN,TIU892591) ; check #2005 pointer back to #8925
  1. N MAG2,PARENTDFIP,PARENTDFNU,PARENTGRD0
  1. S MAG2=$G(^MAG(2005,MAGIEN,2)) Q:MAG2="" 0
  1. S PARENTDFNU=$P(MAG2,"^",6) ; parent data file number
  1. S PARENTGRD0=$P(MAG2,"^",7) ; parent global root D0
  1. S PARENTDFIP=$P(MAG2,"^",8) ; parent data file image pointer
  1. I PARENTDFNU'=8925 Q 0 ; parent file is not TIU
  1. I PARENTGRD0'=TIUIEN Q 0 ; parent global root D0 not TIUIEN
  1. I PARENTDFIP'=TIU892591 Q 0 ; parent data file image pointer not TIU892591
  1. Q 1
  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 Q:STOP=1 D
  1. . . S ACNUMB="" F S ACNUMB=$O(^TMP("MAG",$J,LOC,EXAMDATE,ACNUMB)) Q:ACNUMB="" Q: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 !,?37,"Clinical Specialty Exams without Images in VistA Imaging"
  1. W !,?93,"From "_FDATE_" to "_TDATE
  1. W !!,"Medical Service: "_LOC,!
  1. W !,"Accession",?20,"Patient Name",?53,"Last4",?60,"Exam Date"
  1. W ?75,"Procedure",!,LN
  1. Q