154 lines
5.3 KiB
Mathematica
154 lines
5.3 KiB
Mathematica
|
MAGDRCU1 ;WOIFO/PMK - List entries in ^MAG(2006.5839) ; 05/06/2004 06:32
|
||
|
|
;;3.0;IMAGING;**10,30**;16-September-2004
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;; | 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. |
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;;
|
||
|
|
Q
|
||
|
|
; This routine lists the entries in the temporary Imaging/CPRS Consult
|
||
|
|
; Request Tracking association file
|
||
|
|
;
|
||
|
|
; XXXX XXX X
|
||
|
|
; XX XX XX XX
|
||
|
|
; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
|
||
|
|
; XX XX XX XXX XX XX XX XX XX XX
|
||
|
|
; XX X XX XX XX XX XXXXXXX XX XX XX XX
|
||
|
|
; XX XX XX XX XX XX XX XX XX XX XX XX
|
||
|
|
; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
|
||
|
|
;
|
||
|
|
; Routine 1/2 for application
|
||
|
|
;
|
||
|
|
ENTRY ; read the entries in file ^MAG(2006.5839)
|
||
|
|
N COUNT,CUTOFF,DAYS,DIVISION,DONE,INDEX,SELECT,SERVICE,SORT,SUBTITLE,TITLE,X
|
||
|
|
;
|
||
|
|
S TITLE="UNREAD LIST FOR HEALTHCARE PROVIDERS"
|
||
|
|
W !!,TITLE,!!
|
||
|
|
;
|
||
|
|
; get the division and service list
|
||
|
|
S SERVICE=0 F S SERVICE=$O(^MAG(2006.5831,SERVICE)) Q:'SERVICE D
|
||
|
|
. S X=^MAG(2006.5831,SERVICE,0)
|
||
|
|
. S INDEX=$P(X,"^",2),DIVISION=$P(X,"^",3)
|
||
|
|
. S SERVICE(DIVISION)=$$GET1^DIQ(4,DIVISION,.01)
|
||
|
|
. S SERVICE(DIVISION,INDEX)=$P(^MAG(2005.84,INDEX,0),"^",1)
|
||
|
|
. S SERVICE(DIVISION,INDEX,SERVICE)=$$GET1^DIQ(123.5,SERVICE,.01)
|
||
|
|
. Q
|
||
|
|
;
|
||
|
|
I '$D(SERVICE) W !,"No SERVICEs are defined in file 2006.5831" Q
|
||
|
|
;
|
||
|
|
; select the SERVICE of interest
|
||
|
|
S DONE=0 F D Q:DONE
|
||
|
|
. S COUNT=0,DIVISION=""
|
||
|
|
. W !
|
||
|
|
. F S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION D
|
||
|
|
. . S INDEX=""
|
||
|
|
. . F S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX="" D
|
||
|
|
. . . S COUNT=COUNT+1
|
||
|
|
. . . W !,$J(COUNT,2),") ",$J(DIVISION,4)," -- ",SERVICE(DIVISION)
|
||
|
|
. . . W " -- ",SERVICE(DIVISION,INDEX)
|
||
|
|
. . . S SERVICE("B",COUNT)=DIVISION_"^"_INDEX
|
||
|
|
. . . Q
|
||
|
|
. . Q
|
||
|
|
. I COUNT=1 S SELECT="ALL",DONE=1
|
||
|
|
. E D
|
||
|
|
. . W !!,"Select the proper service (1-",COUNT,") or enter ALL: " R X:DTIME
|
||
|
|
. . I X?.N,X,X'>COUNT S SELECT=SERVICE("B",X),DONE=1
|
||
|
|
. . E I $L(X),"Aa"[$E(X) S SELECT="ALL",DONE=1
|
||
|
|
. . E I X["^" S DONE=-1
|
||
|
|
. . E I X["?" D
|
||
|
|
. . . W !!,"Please enter the number of the corresponding service."
|
||
|
|
. . . W !,"Enter ""ALL"" if you want all of the services."
|
||
|
|
. . . Q
|
||
|
|
. . E W " ???"
|
||
|
|
. . Q
|
||
|
|
. Q
|
||
|
|
I DONE=-1 Q ; cancelled by user
|
||
|
|
;
|
||
|
|
I SELECT="ALL" D
|
||
|
|
. S DIVISION=""
|
||
|
|
. F S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION D
|
||
|
|
. . S INDEX=""
|
||
|
|
. . F S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX="" D
|
||
|
|
. . . D SELSERV(DIVISION,INDEX)
|
||
|
|
. . . Q
|
||
|
|
E D
|
||
|
|
. S DIVISION=$P(SELECT,"^",1),INDEX=$P(SELECT,"^",2)
|
||
|
|
. D SELSERV(DIVISION,INDEX)
|
||
|
|
. Q
|
||
|
|
;
|
||
|
|
S DONE=0 F D Q:DONE
|
||
|
|
. W !!,"Display studies older than how many days? 0// "
|
||
|
|
. R X:DTIME I X="" S X=0 W X
|
||
|
|
. I X?.N S DAYS=X,DONE=1 Q
|
||
|
|
. E I X["^" S DONE=-1
|
||
|
|
. E I X["?" D
|
||
|
|
. . W !!,"Please enter the minimum number of days that have elapsed since"
|
||
|
|
. . W !,"the examination was performed. This allows only the old studies"
|
||
|
|
. . W !,"to be reported. Enter 0 days to display all the studies."
|
||
|
|
. . Q
|
||
|
|
. E W " ???"
|
||
|
|
. Q
|
||
|
|
I DONE=-1 Q ; cancelled by user
|
||
|
|
S %H=($H+1)-DAYS D YMD^%DTC S CUTOFF=X
|
||
|
|
;
|
||
|
|
S DONE=0 F D Q:DONE
|
||
|
|
. W !!,"Sort by patient name or examination date? (N or D) D// "
|
||
|
|
. R X:DTIME I X="" S X="D" W X
|
||
|
|
. I "NnDd"[$E(X) S SORT=X,DONE=1 Q
|
||
|
|
. E I X["^" S DONE=-1
|
||
|
|
. E I X["?" D
|
||
|
|
. . W !!,"Designate the sort order for the report, alphabetically by patient"
|
||
|
|
. . W !,"name or chronologically by the examination date."
|
||
|
|
. . Q
|
||
|
|
. E W " ???"
|
||
|
|
. Q
|
||
|
|
I DONE=-1 Q ; cancelled by user
|
||
|
|
;
|
||
|
|
I SELECT="ALL" S SUBTITLE(1)="ALL SERVICES"
|
||
|
|
E D
|
||
|
|
. S SUBTITLE(1)=$P(SELECT,"^",1)_" -- "_SERVICE($P(SELECT,"^",1))
|
||
|
|
. S SUBTITLE(1)=SUBTITLE(1)_" -- "_SERVICE($P(SELECT,"^",1),$P(SELECT,"^",2))
|
||
|
|
. Q
|
||
|
|
I DAYS S SUBTITLE(2)="Studies more than "_DAYS_" days old"
|
||
|
|
E S SUBTITLE(2)="All studies regardless of age"
|
||
|
|
S SUBTITLE(2)=SUBTITLE(2)_" sorted by "_$S(SORT="D":"date",1:"name")
|
||
|
|
;
|
||
|
|
; Output the report
|
||
|
|
;
|
||
|
|
W ! S %ZIS="Q" D ^%ZIS I POP Q ; select the output device, quit if none
|
||
|
|
;
|
||
|
|
; setup for queueing the report to print in the background via Taskman
|
||
|
|
I $D(IO("Q")) D ; queued
|
||
|
|
. S ZTSAVE("CUTOFF")=""
|
||
|
|
. S ZTSAVE("SELECT")=""
|
||
|
|
. S ZTSAVE("SERVICE(")=""
|
||
|
|
. S ZTSAVE("SORT")=""
|
||
|
|
. S ZTSAVE("SUBTITLE(")=""
|
||
|
|
. S ZTSAVE("TITLE")=""
|
||
|
|
. S ZTRTN="REPORT^MAGDRCU2",ZTDESC=TITLE
|
||
|
|
. D ^%ZTLOAD D HOME^%ZIS K IO("Q")
|
||
|
|
. Q
|
||
|
|
E D ; immediate
|
||
|
|
. D REPORT^MAGDRCU2
|
||
|
|
. Q
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SELSERV(DIVISION,INDEX) ; select service
|
||
|
|
N S
|
||
|
|
S S=""
|
||
|
|
F S S=$O(SERVICE(DIVISION,INDEX,S)) Q:S="" D
|
||
|
|
. S SERVICE("S",S)=SERVICE(DIVISION,INDEX,S)
|
||
|
|
. Q
|
||
|
|
Q
|
||
|
|
;
|