Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDRCU1

MAGDRCU1.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ; This routine lists the entries in the temporary Imaging/CPRS Consult
  1.  ; Request Tracking association file
  1.  ;
  1.  ;     XXXX                                         XXX       X
  1.  ;    XX  XX                                         XX      XX
  1.  ;   XX         XXXX    XX XXX  XXXXXXX  XX  XXX     XX     XXXXX
  1.  ;   XX        XX  XX   XXX XX  XX       XX  XX      XX      XX
  1.  ;   XX    X   XX  XX   XX  XX  XXXXXXX  XX  XX      XX      XX
  1.  ;    XX  XX   XX  XX   XX  XX       XX  XX  XX      XX      XX XX
  1.  ;     XXXX     XXXX    XX  XX  XXXXXXX   XXX XX    XXXX      XXX
  1.  ;
  1.  ; Routine 1/2 for application
  1.  ;
  1. ENTRY ; read the entries in file ^MAG(2006.5839)
  1.  N %ZIS,COUNT,CUTOFF,DAYS,DIVISION,DONE,IEN,INDEX,POP
  1.  N SELECT,SERVICE,SORT,SUBTITLE,TITLE,X,ZTDESC,ZTRTN,ZTSAVE
  1.  ;
  1.  S TITLE="UNREAD LIST FOR CLINICAL SPECIALTY DICOM & HL7"
  1.  W !!,TITLE,!!
  1.  ;
  1.  ; get the division and service list
  1.  S IEN=0 F  S IEN=$O(^MAG(2006.5831,IEN)) Q:'IEN  D
  1.  . S X=^MAG(2006.5831,IEN,0)
  1.  . S SERVICE=$P(X,"^",1),INDEX=$P(X,"^",3),DIVISION=$P(X,"^",5)
  1.  . S SERVICE(DIVISION)=$$GET1^DIQ(4,DIVISION,.01)
  1.  . S SERVICE(DIVISION,INDEX)=$P(^MAG(2005.84,INDEX,0),"^",1)
  1.  . S SERVICE(DIVISION,INDEX,SERVICE)=$$GET1^DIQ(123.5,SERVICE,.01)
  1.  . Q
  1.  ;
  1.  I '$D(SERVICE) W !,"No SERVICEs are defined in file 2006.5831" Q
  1.  ;
  1.  ; select the SERVICE of interest
  1.  S DONE=0 F  D  Q:DONE
  1.  . S COUNT=0,DIVISION=""
  1.  . W !
  1.  . F  S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION  D
  1.  . . S INDEX=""
  1.  . . F  S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX=""  D
  1.  . . . S COUNT=COUNT+1
  1.  . . . W !,$J(COUNT,2),") ",$J(DIVISION,4)," -- ",SERVICE(DIVISION)
  1.  . . . W " -- ",SERVICE(DIVISION,INDEX)
  1.  . . . S SERVICE("B",COUNT)=DIVISION_"^"_INDEX
  1.  . . . Q
  1.  . . Q
  1.  . I COUNT=1 S SELECT="ALL",DONE=1
  1.  . E  D
  1.  . . W !!,"Select the proper service (1-",COUNT,") or enter ALL: " R X:DTIME
  1.  . . I X?.N,X,X'>COUNT S SELECT=SERVICE("B",X),DONE=1
  1.  . . E  I $L(X),"Aa"[$E(X) S SELECT="ALL",DONE=1
  1.  . . E  I X["^" S DONE=-1
  1.  . . E  I X["?" D
  1.  . . . W !!,"Please enter the number of the corresponding service."
  1.  . . . W !,"Enter ""ALL"" if you want all of the services."
  1.  . . . Q
  1.  . . E  W " ???"
  1.  . . Q
  1.  . Q
  1.  I DONE=-1 Q  ; cancelled by user
  1.  ;
  1.  I SELECT="ALL" D
  1.  . S DIVISION=""
  1.  . F  S DIVISION=$O(SERVICE(DIVISION)) Q:'DIVISION  D
  1.  . . S INDEX=""
  1.  . . F  S INDEX=$O(SERVICE(DIVISION,INDEX)) Q:INDEX=""  D
  1.  . . . D SELSERV(DIVISION,INDEX)
  1.  . . . Q
  1.  E  D
  1.  . S DIVISION=$P(SELECT,"^",1),INDEX=$P(SELECT,"^",2)
  1.  . D SELSERV(DIVISION,INDEX)
  1.  . Q
  1.  ;
  1.  S DONE=0 F  D  Q:DONE
  1.  . W !!,"Display studies older than how many days?  0// "
  1.  . R X:DTIME I X="" S X=0 W X
  1.  . I X?.N S DAYS=X,DONE=1 Q
  1.  . E  I X["^" S DONE=-1
  1.  . E  I X["?" D
  1.  . . W !!,"Please enter the minimum number of days that have elapsed since"
  1.  . . W !,"the examination was performed.  This allows only the old studies"
  1.  . . W !,"to be reported.  Enter 0 days to display all the studies."
  1.  . . Q
  1.  . E  W " ???"
  1.  . Q
  1.  I DONE=-1 Q  ; cancelled by user
  1.  S CUTOFF=$$HTFM^XLFDT($H+1-DAYS,0)
  1.  ;
  1.  S DONE=0 F  D  Q:DONE
  1.  . W !!,"Sort by patient name or examination date? (N or D) D// "
  1.  . R X:DTIME I X="" S X="D" W X
  1.  . I "NnDd"[$E(X) S SORT=X,DONE=1 Q
  1.  . E  I X["^" S DONE=-1
  1.  . E  I X["?" D
  1.  . . W !!,"Designate the sort order for the report, alphabetically by patient"
  1.  . . W !,"name or chronologically by the examination date."
  1.  . . Q
  1.  . E  W " ???"
  1.  . Q
  1.  I DONE=-1 Q  ; cancelled by user
  1.  ;
  1.  I SELECT="ALL" S SUBTITLE(1)="ALL SERVICES"
  1.  E  D
  1.  . S SUBTITLE(1)=$P(SELECT,"^",1)_" -- "_SERVICE($P(SELECT,"^",1))
  1.  . S SUBTITLE(1)=SUBTITLE(1)_" -- "_SERVICE($P(SELECT,"^",1),$P(SELECT,"^",2))
  1.  . Q
  1.  I DAYS S SUBTITLE(2)="Studies more than "_DAYS_" days old"
  1.  E  S SUBTITLE(2)="All studies regardless of age"
  1.  S SUBTITLE(2)=SUBTITLE(2)_" sorted by "_$S(SORT="D":"date",1:"name")
  1.  ;
  1.  ; Output the report
  1.  ;
  1.  W ! S %ZIS="Q" D ^%ZIS I POP Q  ; select the output device, quit if none
  1.  ;
  1.  ; setup for queueing the report to print in the background via Taskman 
  1.  I $D(IO("Q")) D  ; queued
  1.  . S ZTSAVE("CUTOFF")=""
  1.  . S ZTSAVE("SELECT")=""
  1.  . S ZTSAVE("SERVICE(")=""
  1.  . S ZTSAVE("SORT")=""
  1.  . S ZTSAVE("SUBTITLE(")=""
  1.  . S ZTSAVE("TITLE")=""
  1.  . S ZTRTN="REPORT^MAGDRCU2",ZTDESC=TITLE
  1.  . D ^%ZTLOAD D HOME^%ZIS
  1.  . Q
  1.  E  D  ; immediate
  1.  . D REPORT^MAGDRCU2
  1.  . Q
  1.  Q
  1.  ;
  1. SELSERV(DIVISION,INDEX) ; select service
  1.  N S
  1.  S S=""
  1.  F  S S=$O(SERVICE(DIVISION,INDEX,S)) Q:S=""  D
  1.  . S SERVICE("S",S)=SERVICE(DIVISION,INDEX,S)
  1.  . Q
  1.  Q
  1.  ;