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

MAGXCVP.m

Go to the documentation of this file. 
  1. MAGXCVP ;WOIFO/SEB,MLH - Image Index Conversion Generate & Commit ; 05/18/2007 11:23
  1.  ;;3.0;IMAGING;**17,25,31,54**;03-July-2009;;Build 1424
  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.  ;
  1.  ; Input starting and ending IENs. Return in variables START and END.
  1. BOUNDS(START,END) N TEMP
  1. START R !,"From ID: 1 // ",START:DTIME
  1.  I $E(START)="?" D  G START
  1.  . W !!,"Please enter the ID of an entry in the image file. This will be the first image"
  1.  . W !,"in the range of images processed by this menu option.",!
  1.  . Q
  1.  I START="" S START=1
  1.  I START="^" Q
  1.  I +START'=START W !!,"Please enter a starting image ID - numbers only." G START
  1. END R !,"To ID: LAST // ",END:DTIME
  1.  I $E(END)="?" D  G END
  1.  . W !!,"Please enter the ID of an entry in the image file. This will be the last image"
  1.  . W !,"in the range of images processed by this menu option.",!
  1.  . Q
  1.  I "^LAST"[("^"_$$UCASE(END)) D  ; includes null response default
  1.  . W "  LAST"
  1.  . S END=+$P($G(^MAG(2005,0)),U,3)
  1.  . Q
  1.  I END="^" S START="^" Q
  1.  I +END'=END W !!,"Please enter an ending image ID - numbers only." G END
  1.  I START>END D  G END ;S TEMP=END,END=START,START=TEMP
  1.  . W !!,"'To ID' value must not be less than 'From ID' value."
  1.  . Q
  1.  Q
  1.  ;
  1.  ; Prompt whether the user wishes to recreate previously-calculated indices. Return in FLAG.
  1. RECREATE(FLAG) S FLAG=""
  1. RECR R !,"Recreate previously calculated indices? Y // ",FLAG:DTIME
  1.  S FLAG=$$UCASE($E(FLAG)) I FLAG="" S FLAG="Y"
  1.  I FLAG="?" D  G RECR
  1.  . W !!,"Entering YES will cause index fields that have been calculated by a previous"
  1.  . W !,"execution of this option to be recalculated. Entering NO will cause the option"
  1.  . W !,"to skip images that already have index fields.",!
  1.  . Q
  1.  I "YN^"'[FLAG W !!,"Please enter YES or NO." G RECR
  1.  Q
  1.  ;
  1.  ; Ask if user wishes to job a task into the background with TaskMan. Returns NULL if
  1.  ; the user wishes to run it in the foreground, and a schedule date/time if the user
  1.  ; wishes to use TaskMan.
  1. TASKMAN(RETURN) N ASK,X,%DT
  1.  I '$$TM^%ZTLOAD() S RETURN="" Q
  1. TMA R !,"Would you like to schedule this with TaskMan? Y // ",ASK:DTIME
  1.  S ASK=$$UCASE($E(ASK))
  1.  I ASK="?" D  G TMA
  1.  . W !!,"Entering YES will run this task with TaskMan. Entering NO will cause it to"
  1.  . W !,"run in the foreground.",!
  1.  I "YN^"'[ASK W !!,"Please enter YES or NO." G TMA
  1.  I ASK="^" S RETURN="^" Q
  1.  I ASK="N" S RETURN="" Q
  1. SCHED R !!,"Please enter the date/time for scheduling the task: NOW // ",X:DTIME I X="" S X="NOW"
  1.  I X="^" S RETURN="^" Q
  1.  S %DT="R" D ^%DT I Y=-1 G SCHED
  1.  S RETURN=Y Q
  1.  Q
  1.  ;
  1. DONE W !!,"Done!"
  1.  Q
  1.  ;
  1.  ; Generate a notification message and send it to group MAG SERVER
  1. NOTIFY(RESULT,SUBJECT,STARTDT,ENDDT,STARTIEN,ENDIEN,RECR) N Y,LOC,XMSUB,DIS,CAP,CNT,I,VR,DM,SUMMARY
  1.  K ^TMP($J,"MAGQ")
  1.  S Y=$$HTE^XLFDT($H,1) ; EdM: is Y used anywhere?
  1.  S U="^",LOC=$$KSP^XUPARAM("WHERE")
  1.  S SUBJECT=$G(SUBJECT)
  1.  I +SUBJECT=SUBJECT S SUBJECT=$P("Generate^Commit",U,SUBJECT)
  1.  S XMSUB=SUBJECT_" Image Index Conversion Values: "_$G(ENDDT)
  1.  S ^TMP($J,"MAGQ",1)="Status: "_$$ST^MAGXCVR
  1.  S ^TMP($J,"MAGQ",2)="Started on: "_$G(STARTDT)
  1.  S ^TMP($J,"MAGQ",3)="Finished on: "_$G(ENDDT)
  1.  S ^TMP($J,"MAGQ",4)="Starting IEN: "_$G(STARTIEN)
  1.  S ^TMP($J,"MAGQ",5)="Ending IEN: "_$G(ENDIEN)
  1.  S ^TMP($J,"MAGQ",6)="Recreate Indices: "_$G(RECR)
  1.  S SUMMARY=""
  1.  F I=7:1 S SUMMARY=$O(^XTMP("MAG30P25","SUMMARY",SUMMARY)) Q:SUMMARY=""  D
  1.  . S ^TMP($J,"MAGQ",I)=SUMMARY_U_^XTMP("MAG30P25","SUMMARY",SUMMARY)
  1.  . Q
  1.  N XMY,XMTEXT
  1.  S XMTEXT="^TMP($J,""MAGQ"","
  1.  S:$G(DUZ) XMY(DUZ)=""
  1.  S XMY("G.MAG SERVER")=""
  1.  S:$G(MAGDUZ) XMY(MAGDUZ)=""
  1.  D ^XMD
  1.  S RESULT="1"
  1.  K ^TMP($J,"MAGQ")
  1.  Q
  1.  ; 
  1.  ; Convert a string to all uppercase.
  1. UCASE(STRING) N OUTPUT
  1.  S OUTPUT=$TR(STRING,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  Q OUTPUT
  1.  ;
  1.  ; Convert a string to all lowercase.
  1. LCASE(STRING) N OUTPUT
  1.  S OUTPUT=$TR(STRING,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1.  Q OUTPUT
  1.  ;
  1.  ; Strip leading and trailing spaces.
  1. STRIP(STRING) N START,END
  1.  F START=1:1:$L(STRING) I $E(STRING,START)'=" " Q
  1.  F END=$L(STRING):-1:1 I $E(STRING,END)'=" " Q
  1.  Q $E(STRING,START,END)
  1.  ;
  1. SCRUBTKN(XSTRING) ; FUNCTION - Create standard token delimiters for parsing
  1.  ; by changing all punctuation to spaces.
  1.  N STRING ; output string
  1.  S STRING=$TR(XSTRING,"+-/\.,~`!@#$%^&*()_-={}[]|:;""'<>?","                                 ")
  1.  ; compress multiple spaces to single space
  1.  F  Q:STRING'["  "  S STRING=$P(STRING,"  ",1)_" "_$P(STRING,"  ",2,999)
  1.  Q STRING
  1.  ;