MAGDRCU1 ;WOIFO/PMK - List entries in ^MAG(2006.5839) ; 07 Mar 2013 10:55 AM
;;3.0;IMAGING;**10,30,54,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; 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. |
;; +---------------------------------------------------------------+
;;
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 %ZIS,COUNT,CUTOFF,DAYS,DIVISION,DONE,IEN,INDEX,POP
N SELECT,SERVICE,SORT,SUBTITLE,TITLE,X,ZTDESC,ZTRTN,ZTSAVE
;
S TITLE="UNREAD LIST FOR CLINICAL SPECIALTY DICOM & HL7"
W !!,TITLE,!!
;
; get the division and service list
S IEN=0 F S IEN=$O(^MAG(2006.5831,IEN)) Q:'IEN D
. S X=^MAG(2006.5831,IEN,0)
. S SERVICE=$P(X,"^",1),INDEX=$P(X,"^",3),DIVISION=$P(X,"^",5)
. 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 CUTOFF=$$HTFM^XLFDT($H+1-DAYS,0)
;
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
. 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRCU1 5673 printed Apr 09, 2024@21:06:18 Page 2
MAGDRCU1 ;WOIFO/PMK - List entries in ^MAG(2006.5839) ; 07 Mar 2013 10:55 AM
+1 ;;3.0;IMAGING;**10,30,54,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+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 QUIT
+18 ; This routine lists the entries in the temporary Imaging/CPRS Consult
+19 ; Request Tracking association file
+20 ;
+21 ; XXXX XXX X
+22 ; XX XX XX XX
+23 ; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
+24 ; XX XX XX XXX XX XX XX XX XX XX
+25 ; XX X XX XX XX XX XXXXXXX XX XX XX XX
+26 ; XX XX XX XX XX XX XX XX XX XX XX XX
+27 ; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
+28 ;
+29 ; Routine 1/2 for application
+30 ;
ENTRY ; read the entries in file ^MAG(2006.5839)
+1 NEW %ZIS,COUNT,CUTOFF,DAYS,DIVISION,DONE,IEN,INDEX,POP
+2 NEW SELECT,SERVICE,SORT,SUBTITLE,TITLE,X,ZTDESC,ZTRTN,ZTSAVE
+3 ;
+4 SET TITLE="UNREAD LIST FOR CLINICAL SPECIALTY DICOM & HL7"
+5 WRITE !!,TITLE,!!
+6 ;
+7 ; get the division and service list
+8 SET IEN=0
FOR
SET IEN=$ORDER(^MAG(2006.5831,IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 SET X=^MAG(2006.5831,IEN,0)
+10 SET SERVICE=$PIECE(X,"^",1)
SET INDEX=$PIECE(X,"^",3)
SET DIVISION=$PIECE(X,"^",5)
+11 SET SERVICE(DIVISION)=$$GET1^DIQ(4,DIVISION,.01)
+12 SET SERVICE(DIVISION,INDEX)=$PIECE(^MAG(2005.84,INDEX,0),"^",1)
+13 SET SERVICE(DIVISION,INDEX,SERVICE)=$$GET1^DIQ(123.5,SERVICE,.01)
+14 QUIT
End DoDot:1
+15 ;
+16 IF '$DATA(SERVICE)
WRITE !,"No SERVICEs are defined in file 2006.5831"
QUIT
+17 ;
+18 ; select the SERVICE of interest
+19 SET DONE=0
FOR
Begin DoDot:1
+20 SET COUNT=0
SET DIVISION=""
+21 WRITE !
+22 FOR
SET DIVISION=$ORDER(SERVICE(DIVISION))
if 'DIVISION
QUIT
Begin DoDot:2
+23 SET INDEX=""
+24 FOR
SET INDEX=$ORDER(SERVICE(DIVISION,INDEX))
if INDEX=""
QUIT
Begin DoDot:3
+25 SET COUNT=COUNT+1
+26 WRITE !,$JUSTIFY(COUNT,2),") ",$JUSTIFY(DIVISION,4)," -- ",SERVICE(DIVISION)
+27 WRITE " -- ",SERVICE(DIVISION,INDEX)
+28 SET SERVICE("B",COUNT)=DIVISION_"^"_INDEX
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 IF COUNT=1
SET SELECT="ALL"
SET DONE=1
+32 IF '$TEST
Begin DoDot:2
+33 WRITE !!,"Select the proper service (1-",COUNT,") or enter ALL: "
READ X:DTIME
+34 IF X?.N
IF X
IF X'>COUNT
SET SELECT=SERVICE("B",X)
SET DONE=1
+35 IF '$TEST
IF $LENGTH(X)
IF "Aa"[$EXTRACT(X)
SET SELECT="ALL"
SET DONE=1
+36 IF '$TEST
IF X["^"
SET DONE=-1
+37 IF '$TEST
IF X["?"
Begin DoDot:3
+38 WRITE !!,"Please enter the number of the corresponding service."
+39 WRITE !,"Enter ""ALL"" if you want all of the services."
+40 QUIT
End DoDot:3
+41 IF '$TEST
WRITE " ???"
+42 QUIT
End DoDot:2
+43 QUIT
End DoDot:1
if DONE
QUIT
+44 ; cancelled by user
IF DONE=-1
QUIT
+45 ;
+46 IF SELECT="ALL"
Begin DoDot:1
+47 SET DIVISION=""
+48 FOR
SET DIVISION=$ORDER(SERVICE(DIVISION))
if 'DIVISION
QUIT
Begin DoDot:2
+49 SET INDEX=""
+50 FOR
SET INDEX=$ORDER(SERVICE(DIVISION,INDEX))
if INDEX=""
QUIT
Begin DoDot:3
+51 DO SELSERV(DIVISION,INDEX)
+52 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+53 IF '$TEST
Begin DoDot:1
+54 SET DIVISION=$PIECE(SELECT,"^",1)
SET INDEX=$PIECE(SELECT,"^",2)
+55 DO SELSERV(DIVISION,INDEX)
+56 QUIT
End DoDot:1
+57 ;
+58 SET DONE=0
FOR
Begin DoDot:1
+59 WRITE !!,"Display studies older than how many days? 0// "
+60 READ X:DTIME
IF X=""
SET X=0
WRITE X
+61 IF X?.N
SET DAYS=X
SET DONE=1
QUIT
+62 IF '$TEST
IF X["^"
SET DONE=-1
+63 IF '$TEST
IF X["?"
Begin DoDot:2
+64 WRITE !!,"Please enter the minimum number of days that have elapsed since"
+65 WRITE !,"the examination was performed. This allows only the old studies"
+66 WRITE !,"to be reported. Enter 0 days to display all the studies."
+67 QUIT
End DoDot:2
+68 IF '$TEST
WRITE " ???"
+69 QUIT
End DoDot:1
if DONE
QUIT
+70 ; cancelled by user
IF DONE=-1
QUIT
+71 SET CUTOFF=$$HTFM^XLFDT($HOROLOG+1-DAYS,0)
+72 ;
+73 SET DONE=0
FOR
Begin DoDot:1
+74 WRITE !!,"Sort by patient name or examination date? (N or D) D// "
+75 READ X:DTIME
IF X=""
SET X="D"
WRITE X
+76 IF "NnDd"[$EXTRACT(X)
SET SORT=X
SET DONE=1
QUIT
+77 IF '$TEST
IF X["^"
SET DONE=-1
+78 IF '$TEST
IF X["?"
Begin DoDot:2
+79 WRITE !!,"Designate the sort order for the report, alphabetically by patient"
+80 WRITE !,"name or chronologically by the examination date."
+81 QUIT
End DoDot:2
+82 IF '$TEST
WRITE " ???"
+83 QUIT
End DoDot:1
if DONE
QUIT
+84 ; cancelled by user
IF DONE=-1
QUIT
+85 ;
+86 IF SELECT="ALL"
SET SUBTITLE(1)="ALL SERVICES"
+87 IF '$TEST
Begin DoDot:1
+88 SET SUBTITLE(1)=$PIECE(SELECT,"^",1)_" -- "_SERVICE($PIECE(SELECT,"^",1))
+89 SET SUBTITLE(1)=SUBTITLE(1)_" -- "_SERVICE($PIECE(SELECT,"^",1),$PIECE(SELECT,"^",2))
+90 QUIT
End DoDot:1
+91 IF DAYS
SET SUBTITLE(2)="Studies more than "_DAYS_" days old"
+92 IF '$TEST
SET SUBTITLE(2)="All studies regardless of age"
+93 SET SUBTITLE(2)=SUBTITLE(2)_" sorted by "_$SELECT(SORT="D":"date",1:"name")
+94 ;
+95 ; Output the report
+96 ;
+97 ; select the output device, quit if none
WRITE !
SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+98 ;
+99 ; setup for queueing the report to print in the background via Taskman
+100 ; queued
IF $DATA(IO("Q"))
Begin DoDot:1
+101 SET ZTSAVE("CUTOFF")=""
+102 SET ZTSAVE("SELECT")=""
+103 SET ZTSAVE("SERVICE(")=""
+104 SET ZTSAVE("SORT")=""
+105 SET ZTSAVE("SUBTITLE(")=""
+106 SET ZTSAVE("TITLE")=""
+107 SET ZTRTN="REPORT^MAGDRCU2"
SET ZTDESC=TITLE
+108 DO ^%ZTLOAD
DO HOME^%ZIS
+109 QUIT
End DoDot:1
+110 ; immediate
IF '$TEST
Begin DoDot:1
+111 DO REPORT^MAGDRCU2
+112 QUIT
End DoDot:1
+113 QUIT
+114 ;
SELSERV(DIVISION,INDEX) ; select service
+1 NEW S
+2 SET S=""
+3 FOR
SET S=$ORDER(SERVICE(DIVISION,INDEX,S))
if S=""
QUIT
Begin DoDot:1
+4 SET SERVICE("S",S)=SERVICE(DIVISION,INDEX,S)
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
