MAGDTRLU ;WOIFO/OHH/PMK - Report discrepancies between files #2006.5849 & #123 and correct them ; 10/11/2006 08:53
;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; This routine automatically checks the data in file telereader
; read/unread list (file 2006.5849)and compares it with the
; request/consultation (file #123). If a telereader study is locked
; or unread and in the request/consult file it is completed or
; cancelled, then it updates the status of the study in the telereader
; read/unread list file, the "D" cross reference, and the reading
; start field is updated.
Q
;
REPORT ; report problems with the Unread List
D PASS("REPORT")
Q
;
REPAIR ; repair problems with the Unread List
D PASS("REPAIR")
Q
;
PASS(MODE) ; report/repair problems for LOCKED and UNREAD studies
N MSG
S (MSG(1),MSG(3))=""
;
; PASS 1 - search for LOCKED cases that are completed/cancelled.
S MSG(2)="Check for completed studies that have LOCKED status"
I MODE="REPAIR" S MSG(2)=MSG(2)_" and correct them"
W !! D HEADING^MAGDTRDX(.MSG)
D SEARCH("LOCKED",MODE)
;
; PASS 2 - search for UNREAD cases that are completed/cancelled.
S MSG(2)="Now check for completed studies that have UNREAD status"
I MODE="REPAIR" S MSG(2)=MSG(2)_" and correct them"
W !! D HEADING^MAGDTRDX(.MSG)
D SEARCH("UNREAD",MODE)
Q
;
SEARCH(STATUS,MODE) ; go through studies for each site, specialty and procedure
N ACQSITE ; -- acquisition division number
N ISPECIDX ; - image index for specialty
N IPROCIDX ; - image index for procedure
N UNREAD ; --- IEN of file telereader read/undread file #2006.5849
N XREF ; ----- "D" cross reference: "L" for locked, "U" for unread
N I
;
S XREF=$E(STATUS)
S ACQSITE=""
F S ACQSITE=$O(^MAG(2006.5849,"D",ACQSITE)) Q:ACQSITE="" D
. W !!,$$W("Acquisition Site:"),$$GET1^DIQ(4,ACQSITE,.01)
. S ISPECIDX=""
. F S ISPECIDX=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX)) Q:ISPECIDX="" D
. . W !,$$W("Specialty:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
. . S IPROCIDX=""
. . F S IPROCIDX=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX)) Q:IPROCIDX="" D
. . . N COUNT ; -- array of counts of problems
. . . W !,$$W("Procedure:"),$$GET1^DIQ(2005.85,IPROCIDX,.01) D
. . . S UNREAD=""
. . . F S UNREAD=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,XREF,UNREAD)) Q:UNREAD="" D CHECK
. . . I '$D(COUNT) D Q
. . . . W !,$$W(""),"No inconsistencies were found.",!
. . . . Q
. . . S I="" F S I=$O(COUNT(I)) Q:I="" D
. . . . W !,$$W($S(MODE="REPORT":"Problem:",1:"Repaired:"))
. . . . W "Number of consults that have ",I," status in CPRS: ",COUNT(I)
. . . . W !
. . . . Q
. . . Q
. . Q
. Q
Q
;
CHECK ;check Unread List entry against that in CPRS Consult Requst Tracking
N GMRCIEN ; -- IEN of file request/consultation (file #123)
N GMRCSTS ; -- status of consult request - from ^ORD(100.01)
;
S GMRCIEN=$P(^MAG(2006.5849,UNREAD,0),"^",1)
S GMRCSTS=$$GET1^DIQ(123,GMRCIEN,8) ; cprs status
I "^COMPLETE^CANCELLED^DISCONTINUED^DISCONTINUED/EDIT^EXPIRED^"[("^"_GMRCSTS_"^") D
. S COUNT(GMRCSTS)=$G(COUNT(GMRCSTS))+1
. I MODE="REPORT" D
. . W !,$$W(""),"Consult # ",GMRCIEN," has the status of ",GMRCSTS," in CPRS"
. . Q
. E I MODE="REPAIR" D ; correct the entry
. . W !,$$W("Fix:"),"Consult # ",GMRCIEN," which has the status of ",GMRCSTS," in CPRS"
. . ; Note: The variable & value MODE="REPAIR" are used in ^MAGDTR03
. . I GMRCSTS="COMPLETE" D
. . . D COMPLETE^MAGDTR03
. . . Q
. . E D CANCEL^MAGDTR03
. . Q
. Q
Q
;
W(PROMPT) ; output prompt
Q $J(PROMPT,16)_" "
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDTRLU 4627 printed Apr 09, 2024@21:06:46 Page 2
MAGDTRLU ;WOIFO/OHH/PMK - Report discrepancies between files #2006.5849 & #123 and correct them ; 10/11/2006 08:53
+1 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ; This routine automatically checks the data in file telereader
+18 ; read/unread list (file 2006.5849)and compares it with the
+19 ; request/consultation (file #123). If a telereader study is locked
+20 ; or unread and in the request/consult file it is completed or
+21 ; cancelled, then it updates the status of the study in the telereader
+22 ; read/unread list file, the "D" cross reference, and the reading
+23 ; start field is updated.
+24 QUIT
+25 ;
REPORT ; report problems with the Unread List
+1 DO PASS("REPORT")
+2 QUIT
+3 ;
REPAIR ; repair problems with the Unread List
+1 DO PASS("REPAIR")
+2 QUIT
+3 ;
PASS(MODE) ; report/repair problems for LOCKED and UNREAD studies
+1 NEW MSG
+2 SET (MSG(1),MSG(3))=""
+3 ;
+4 ; PASS 1 - search for LOCKED cases that are completed/cancelled.
+5 SET MSG(2)="Check for completed studies that have LOCKED status"
+6 IF MODE="REPAIR"
SET MSG(2)=MSG(2)_" and correct them"
+7 WRITE !!
DO HEADING^MAGDTRDX(.MSG)
+8 DO SEARCH("LOCKED",MODE)
+9 ;
+10 ; PASS 2 - search for UNREAD cases that are completed/cancelled.
+11 SET MSG(2)="Now check for completed studies that have UNREAD status"
+12 IF MODE="REPAIR"
SET MSG(2)=MSG(2)_" and correct them"
+13 WRITE !!
DO HEADING^MAGDTRDX(.MSG)
+14 DO SEARCH("UNREAD",MODE)
+15 QUIT
+16 ;
SEARCH(STATUS,MODE) ; go through studies for each site, specialty and procedure
+1 ; -- acquisition division number
NEW ACQSITE
+2 ; - image index for specialty
NEW ISPECIDX
+3 ; - image index for procedure
NEW IPROCIDX
+4 ; --- IEN of file telereader read/undread file #2006.5849
NEW UNREAD
+5 ; ----- "D" cross reference: "L" for locked, "U" for unread
NEW XREF
+6 NEW I
+7 ;
+8 SET XREF=$EXTRACT(STATUS)
+9 SET ACQSITE=""
+10 FOR
SET ACQSITE=$ORDER(^MAG(2006.5849,"D",ACQSITE))
if ACQSITE=""
QUIT
Begin DoDot:1
+11 WRITE !!,$$W("Acquisition Site:"),$$GET1^DIQ(4,ACQSITE,.01)
+12 SET ISPECIDX=""
+13 FOR
SET ISPECIDX=$ORDER(^MAG(2006.5849,"D",ACQSITE,ISPECIDX))
if ISPECIDX=""
QUIT
Begin DoDot:2
+14 WRITE !,$$W("Specialty:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
+15 SET IPROCIDX=""
+16 FOR
SET IPROCIDX=$ORDER(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX))
if IPROCIDX=""
QUIT
Begin DoDot:3
+17 ; -- array of counts of problems
NEW COUNT
+18 WRITE !,$$W("Procedure:"),$$GET1^DIQ(2005.85,IPROCIDX,.01)
Begin DoDot:4
End DoDot:4
+19 SET UNREAD=""
+20 FOR
SET UNREAD=$ORDER(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,XREF,UNREAD))
if UNREAD=""
QUIT
DO CHECK
+21 IF '$DATA(COUNT)
Begin DoDot:4
+22 WRITE !,$$W(""),"No inconsistencies were found.",!
+23 QUIT
End DoDot:4
QUIT
+24 SET I=""
FOR
SET I=$ORDER(COUNT(I))
if I=""
QUIT
Begin DoDot:4
+25 WRITE !,$$W($SELECT(MODE="REPORT":"Problem:",1:"Repaired:"))
+26 WRITE "Number of consults that have ",I," status in CPRS: ",COUNT(I)
+27 WRITE !
+28 QUIT
End DoDot:4
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
CHECK ;check Unread List entry against that in CPRS Consult Requst Tracking
+1 ; -- IEN of file request/consultation (file #123)
NEW GMRCIEN
+2 ; -- status of consult request - from ^ORD(100.01)
NEW GMRCSTS
+3 ;
+4 SET GMRCIEN=$PIECE(^MAG(2006.5849,UNREAD,0),"^",1)
+5 ; cprs status
SET GMRCSTS=$$GET1^DIQ(123,GMRCIEN,8)
+6 IF "^COMPLETE^CANCELLED^DISCONTINUED^DISCONTINUED/EDIT^EXPIRED^"[("^"_GMRCSTS_"^")
Begin DoDot:1
+7 SET COUNT(GMRCSTS)=$GET(COUNT(GMRCSTS))+1
+8 IF MODE="REPORT"
Begin DoDot:2
+9 WRITE !,$$W(""),"Consult # ",GMRCIEN," has the status of ",GMRCSTS," in CPRS"
+10 QUIT
End DoDot:2
+11 ; correct the entry
IF '$TEST
IF MODE="REPAIR"
Begin DoDot:2
+12 WRITE !,$$W("Fix:"),"Consult # ",GMRCIEN," which has the status of ",GMRCSTS," in CPRS"
+13 ; Note: The variable & value MODE="REPAIR" are used in ^MAGDTR03
+14 IF GMRCSTS="COMPLETE"
Begin DoDot:3
+15 DO COMPLETE^MAGDTR03
+16 QUIT
End DoDot:3
+17 IF '$TEST
DO CANCEL^MAGDTR03
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
W(PROMPT) ; output prompt
+1 QUIT $JUSTIFY(PROMPT,16)_" "
