source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDRCU1.m@ 1005

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

initial load of WorldVistAEHR
File size: 5.3 KB
Line 
1MAGDRCU1 ;WOIFO/PMK - List entries in ^MAG(2006.5839) ; 05/06/2004 06:32
2 ;;3.0;IMAGING;**10,30**;16-September-2004
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 ;; | |
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 ;;
18 Q
19 ; This routine lists the entries in the temporary Imaging/CPRS Consult
20 ; Request Tracking association file
21 ;
22 ; XXXX XXX X
23 ; XX XX XX XX
24 ; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
25 ; XX XX XX XXX XX XX XX XX XX XX
26 ; XX X XX XX XX XX XXXXXXX XX XX XX XX
27 ; XX XX XX XX XX XX XX XX XX XX XX XX
28 ; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
29 ;
30 ; Routine 1/2 for application
31 ;
32ENTRY ; read the entries in file ^MAG(2006.5839)
33 N COUNT,CUTOFF,DAYS,DIVISION,DONE,INDEX,SELECT,SERVICE,SORT,SUBTITLE,TITLE,X
34 ;
35 S TITLE="UNREAD LIST FOR HEALTHCARE PROVIDERS"
36 W !!,TITLE,!!
37 ;
38 ; get the division and service list
39 S SERVICE=0 F S SERVICE=$O(^MAG(2006.5831,SERVICE)) Q:'SERVICE D
40 . S X=^MAG(2006.5831,SERVICE,0)
41 . S INDEX=$P(X,"^",2),DIVISION=$P(X,"^",3)
42 . S SERVICE(DIVISION)=$$GET1^DIQ(4,DIVISION,.01)
43 . S SERVICE(DIVISION,INDEX)=$P(^MAG(2005.84,INDEX,0),"^",1)
44 . S SERVICE(DIVISION,INDEX,SERVICE)=$$GET1^DIQ(123.5,SERVICE,.01)
45 . Q
46 ;
47 I '$D(SERVICE) W !,"No SERVICEs are defined in file 2006.5831" Q
48 ;
49 ; select the SERVICE of interest
50 S DONE=0 F D Q:DONE
51 . S COUNT=0,DIVISION=""
52 . W !
53 . F S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION D
54 . . S INDEX=""
55 . . F S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX="" D
56 . . . S COUNT=COUNT+1
57 . . . W !,$J(COUNT,2),") ",$J(DIVISION,4)," -- ",SERVICE(DIVISION)
58 . . . W " -- ",SERVICE(DIVISION,INDEX)
59 . . . S SERVICE("B",COUNT)=DIVISION_"^"_INDEX
60 . . . Q
61 . . Q
62 . I COUNT=1 S SELECT="ALL",DONE=1
63 . E D
64 . . W !!,"Select the proper service (1-",COUNT,") or enter ALL: " R X:DTIME
65 . . I X?.N,X,X'>COUNT S SELECT=SERVICE("B",X),DONE=1
66 . . E I $L(X),"Aa"[$E(X) S SELECT="ALL",DONE=1
67 . . E I X["^" S DONE=-1
68 . . E I X["?" D
69 . . . W !!,"Please enter the number of the corresponding service."
70 . . . W !,"Enter ""ALL"" if you want all of the services."
71 . . . Q
72 . . E W " ???"
73 . . Q
74 . Q
75 I DONE=-1 Q ; cancelled by user
76 ;
77 I SELECT="ALL" D
78 . S DIVISION=""
79 . F S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION D
80 . . S INDEX=""
81 . . F S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX="" D
82 . . . D SELSERV(DIVISION,INDEX)
83 . . . Q
84 E D
85 . S DIVISION=$P(SELECT,"^",1),INDEX=$P(SELECT,"^",2)
86 . D SELSERV(DIVISION,INDEX)
87 . Q
88 ;
89 S DONE=0 F D Q:DONE
90 . W !!,"Display studies older than how many days? 0// "
91 . R X:DTIME I X="" S X=0 W X
92 . I X?.N S DAYS=X,DONE=1 Q
93 . E I X["^" S DONE=-1
94 . E I X["?" D
95 . . W !!,"Please enter the minimum number of days that have elapsed since"
96 . . W !,"the examination was performed. This allows only the old studies"
97 . . W !,"to be reported. Enter 0 days to display all the studies."
98 . . Q
99 . E W " ???"
100 . Q
101 I DONE=-1 Q ; cancelled by user
102 S %H=($H+1)-DAYS D YMD^%DTC S CUTOFF=X
103 ;
104 S DONE=0 F D Q:DONE
105 . W !!,"Sort by patient name or examination date? (N or D) D// "
106 . R X:DTIME I X="" S X="D" W X
107 . I "NnDd"[$E(X) S SORT=X,DONE=1 Q
108 . E I X["^" S DONE=-1
109 . E I X["?" D
110 . . W !!,"Designate the sort order for the report, alphabetically by patient"
111 . . W !,"name or chronologically by the examination date."
112 . . Q
113 . E W " ???"
114 . Q
115 I DONE=-1 Q ; cancelled by user
116 ;
117 I SELECT="ALL" S SUBTITLE(1)="ALL SERVICES"
118 E D
119 . S SUBTITLE(1)=$P(SELECT,"^",1)_" -- "_SERVICE($P(SELECT,"^",1))
120 . S SUBTITLE(1)=SUBTITLE(1)_" -- "_SERVICE($P(SELECT,"^",1),$P(SELECT,"^",2))
121 . Q
122 I DAYS S SUBTITLE(2)="Studies more than "_DAYS_" days old"
123 E S SUBTITLE(2)="All studies regardless of age"
124 S SUBTITLE(2)=SUBTITLE(2)_" sorted by "_$S(SORT="D":"date",1:"name")
125 ;
126 ; Output the report
127 ;
128 W ! S %ZIS="Q" D ^%ZIS I POP Q ; select the output device, quit if none
129 ;
130 ; setup for queueing the report to print in the background via Taskman
131 I $D(IO("Q")) D ; queued
132 . S ZTSAVE("CUTOFF")=""
133 . S ZTSAVE("SELECT")=""
134 . S ZTSAVE("SERVICE(")=""
135 . S ZTSAVE("SORT")=""
136 . S ZTSAVE("SUBTITLE(")=""
137 . S ZTSAVE("TITLE")=""
138 . S ZTRTN="REPORT^MAGDRCU2",ZTDESC=TITLE
139 . D ^%ZTLOAD D HOME^%ZIS K IO("Q")
140 . Q
141 E D ; immediate
142 . D REPORT^MAGDRCU2
143 . Q
144 Q
145 ;
146SELSERV(DIVISION,INDEX) ; select service
147 N S
148 S S=""
149 F S S=$O(SERVICE(DIVISION,INDEX,S)) Q:S="" D
150 . S SERVICE("S",S)=SERVICE(DIVISION,INDEX,S)
151 . Q
152 Q
153 ;
Note: See TracBrowser for help on using the repository browser.