source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDTRDX.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1MAGDTRDX ;WOIFO/PMK - Formatted dump of DICOM MWL & TeleReader dictionaries ; 10/05/2006 06:34
2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18ENTRY ;
19 N ACQSITE,CLINNAME,CLINPTR,D0,D1,D2,D3,DIVISION,IPROCIDX,ISPECIDX
20 N LOCKTIME,MSG,POP,PRIMARY,PROC,ROUTE,STATUS,TIUNOTE,TOSERV
21 N TRIGGER,USERPREF,X,X1,X2,X3
22 D ^%ZIS Q:POP ; Select device quit if none
23 S (MSG(1),MSG(3))=""
24 S MSG(2)="DICOM HEALTHCARE PROVIDER SERVICE (file 2006.5831)"
25 W !! D HEADING(.MSG)
26 S D0=0 F S D0=$O(^MAG(2006.5831,D0)) Q:'D0 D
27 . S X=$G(^MAG(2006.5831,D0,0))
28 . S TOSERV=$P(X,"^",1),ISPECIDX=$P(X,"^",2),DIVISION=$P(X,"^",3)
29 . W !!,$$W("To Service:"),$$GET1^DIQ(123.5,TOSERV,.01)
30 . W !,$$W("Worklist:"),$$GET1^DIQ(2005.84,ISPECIDX,3)
31 . W " (",$$GET1^DIQ(2005.84,ISPECIDX,.01),")"
32 . W " acquired at ",$$GET1^DIQ(4,DIVISION,.01)
33 . S ROUTE=$$GET1^DIQ(123.5,TOSERV,132)
34 . I ROUTE'="" D
35 . . W !,$$W("Remote IFC:"),ROUTE
36 . . Q
37 . S CLINPTR=0
38 . S D1=0 F S D1=$O(^MAG(2006.5831,D0,1,D1)) Q:'D1 D
39 . . I 'CLINPTR W !,$$W("Clinics:")
40 . . S CLINPTR=$G(^MAG(2006.5831,D0,1,D1,0))
41 . . S CLINNAME=$$GET1^DIQ(44,CLINPTR,.01)
42 . . I $X+$L(CLINNAME)>70 W !,$$W("")
43 . . W CLINNAME," "
44 . . Q
45 . Q
46 ;
47 S MSG(2)="TELEREADER ACQUISITION SERVICE (file 2006.5841)"
48 W !! D HEADING(.MSG)
49 S D0=0 F S D0=$O(^MAG(2006.5841,D0)) Q:'D0 D
50 . S X=$G(^MAG(2006.5841,D0,0))
51 . S TOSERV=$P(X,"^",1),PROC=$P(X,"^",2),ISPECIDX=$P(X,"^",3)
52 . S IPROCIDX=$P(X,"^",4),DIVISION=$P(X,"^",5)
53 . S TRIGGER=$P(X,"^",6),TIUNOTE=$P(X,"^",7)
54 . W !!,$$W("To Service:"),$$GET1^DIQ(123.5,TOSERV,.01)
55 . I $D(^MAG(2006.5831,TOSERV,0)) W ?63,"*** DICOM MWL ***"
56 . I PROC W !,$$W("Procedure:"),$$GET1^DIQ(123.3,PROC,.01)
57 . S ROUTE=$$GET1^DIQ(123.5,TOSERV,132)
58 . I ROUTE'="" D
59 . . W !,$$W("Remote IFC:"),ROUTE
60 . . Q
61 . W !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
62 . W " -- ",$$GET1^DIQ(2005.85,IPROCIDX,.01)
63 . W !,$$W("Trigger:")
64 . I TRIGGER="I" W "Create/update with every acquired image"
65 . E I TRIGGER="O" W "Create when request is ordered"
66 . E I TRIGGER="F" W "Create when consult is forwarded"
67 . E W "Unknown trigger value: """,TRIGGER,""""
68 . I TIUNOTE W !,$$W("Note for IFC:"),$$GET1^DIQ(8925.1,TIUNOTE,.01)
69 . Q
70 ;
71 S MSG(2)="TELEREADER ACQUISITION SITE (file 2006.5842)"
72 W !! D HEADING(.MSG)
73 S D0=0 F S D0=$O(^MAG(2006.5842,D0)) Q:'D0 D
74 . S X=$G(^MAG(2006.5842,D0,0))
75 . S ACQSITE=$P(X,"^",1),PRIMARY=$P(X,"^",2)
76 . S STATUS=$P(X,"^",3),LOCKTIME=$P(X,"^",4)
77 . W !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
78 . W ?50,$S(STATUS:"Active",1:"Inactive")
79 . W ?60,"Lock Time: ",LOCKTIME," min."
80 . W !,$$W("Primary Site:"),$$GET1^DIQ(4,PRIMARY,.01)
81 . Q
82 ;
83 S MSG(2)="TELEREADER READER (file 2006.5843)"
84 W !! D HEADING(.MSG)
85 S D0=0 F S D0=$O(^MAG(2006.5843,D0)) Q:'D0 D
86 . S X=$G(^MAG(2006.5843,D0,0))
87 . W:D0>1 !!,$TR($J("",80)," ","-")
88 . W !!,$$W("TeleReader:"),$$GET1^DIQ(200,X,.01)
89 . S D1=0 F S D1=$O(^MAG(2006.5843,D0,1,D1)) Q:'D1 D
90 . . S X1=$G(^MAG(2006.5843,D0,1,D1,0))
91 . . S ACQSITE=$P(X1,"^",1),STATUS=$P(X1,"^",2)
92 . . W !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
93 . . W ?50,$S(STATUS:"Active",1:"Inactive")
94 . . S D2=0 F S D2=$O(^MAG(2006.5843,D0,1,D1,1,D2)) Q:'D2 D
95 . . . S X2=$G(^MAG(2006.5843,D0,1,D1,1,D2,0))
96 . . . S ISPECIDX=$P(X2,"^",1),STATUS=$P(X2,"^",2)
97 . . . W !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
98 . . . W ?50,$S(STATUS:"Active",1:"Inactive")
99 . . . S D3=0 F S D3=$O(^MAG(2006.5843,D0,1,D1,1,D2,1,D3)) Q:'D3 D
100 . . . . S X3=$G(^MAG(2006.5843,D0,1,D1,1,D2,1,D3,0))
101 . . . . S IPROCIDX=$P(X3,"^",1),STATUS=$P(X3,"^",2),USERPREF=$P(X3,"^",3)
102 . . . . W !,$$W(""),$$GET1^DIQ(2005.85,IPROCIDX,.01)
103 . . . . W ?50,$S(STATUS:"Active",1:"Inactive")
104 . . . . W ?65,"User: ",$S(USERPREF:"Active",1:"Inactive")
105 . . . . Q
106 . . . Q
107 . . Q
108 . Q
109 W !,$TR($J("",80)," ","*"),!
110 Q
111 ;
112W(PROMPT) ; output prompt
113 Q $J(PROMPT,13)_" "
114 ;
115HEADING(MSG) ;
116 N I
117 W !,$TR($J("",80)," ","*")
118 I $D(MSG)=1 W !,"*** ",MSG,?76," ***"
119 E F I=1:1 Q:'$D(MSG(I)) W !,"*** ",MSG(I),?76," ***"
120 W !,$TR($J("",80)," ","*")
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.