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

MAGGSIU1.m

Go to the documentation of this file.
  1. MAGGSIU1 ;WOIFO/GEK/NST - Utilities for Image Add/Modify ; 04 Mar 2010 4:04 PM
  1. ;;3.0;IMAGING;**7,8,108**;Mar 19, 2002;Build 1738;May 20, 2010
  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. ; GEK 11/04/2002 Keep MAGGTU1 as utility for DA2NAME and DRIVE
  1. ;
  1. MAKENAME(MAGGFDA) ; get info from the MAGGFDA array
  1. ; For all Images the Name (.01) is first 18 characters of patient name
  1. ; concatenated with SSN.
  1. ; If No patient name is sent, well make the name from the short desc.
  1. ; We were making name of :
  1. ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
  1. N ZDESC,X
  1. S ZDESC=""
  1. ; If we don't have a patient name ( later) we set .01 to Short Desc
  1. ; if it exists.
  1. I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
  1. ; DFN
  1. I $D(MAGGFDA(2005,"+1,",5)) D
  1. . S X=MAGGFDA(2005,"+1,",5)
  1. . ; NAME SSN
  1. . S ZDESC=$E($P(^DPT(X,0),U),1,18)_" "_$P(^DPT(X,0),U,9)
  1. ;
  1. Q ZDESC
  1. MAKECLAS ; Patch 8: This call will attempt to compute an Image CLASS ^ (#41) CLASS [2P]
  1. ; from the TYPE Field (#42) TYPE [3P]
  1. ; Call assumes the FM FDA Array MAGGFDA exists.
  1. ;// Note : this is also called from MAGGTIA. TYPE may not exist.
  1. ; Calling RTN expects MAGERR to exist if error.
  1. N TYPE,CLS
  1. S TYPE=$G(MAGGFDA(2005,"+1,",42))
  1. ; Can't make Type required. yet.
  1. ;I TYPE="" S MAGERR="0^A Value for Field #42 (Image Type) is missing." Q
  1. I TYPE="" Q
  1. S CLS=$P(^MAG(2005.83,TYPE,0),U,2)
  1. I 'CLS S MAGERR="0^Missing Class pointer for TYPE : "_$P(^MAG(2005.83,TYPE,0),U)_" ("_TYPE_")" Q
  1. S MAGGFDA(2005,"+1,",41)=CLS
  1. Q
  1. MAKEPKG ;Patch 8 This call will attempt to compute the field (#40) PACKAGE INDEX [1S] from Patent Data File.
  1. ; Call assumes the FM FDA Array MAGGFDA exists.
  1. N PARENT,PKG,PXIEN,MAGRY,OK,TYPE
  1. S PARENT=$G(MAGGFDA(2005,"+1,",16))
  1. S TYPE=$G(MAGGFDA(2005,"+1,",42))
  1. I (PARENT="")&(TYPE=$$PHOTODA) D Q
  1. . S MAGGFDA(2005,"+1,",40)="PHOTOID"
  1. . ; Need next line, bacause the Method that returns Photo ID for a Pat.
  1. . ; checks for PHOTO ID in the Cross Reference.
  1. . S MAGGFDA(2005,"+1,",6)="PHOTO ID"
  1. . Q
  1. I PARENT="" S MAGGFDA(2005,"+1,",40)="NONE" Q ;MAGERR="0^Missing Parent Data File pointer" Q
  1. I PARENT'=8925 S PKG=$P(^MAG(2005.03,PARENT,2),U) Q
  1. S PXIEN=$G(MAGGFDA(2005,"+1,",17))
  1. D DATA^MAGGNTI(.MAGRY,PXIEN)
  1. D ISCP^TIUCP(.OK,$P(MAGRY,U,2)) I OK S MAGGFDA(2005,"+1,",40)="CP" Q
  1. D ISCNSLT^TIUCNSLT(.OK,$P(MAGRY,U,2)) I OK S MAGGFDA(2005,"+1,",40)="CONS" Q
  1. S MAGGFDA(2005,"+1,",40)="NOTE"
  1. Q
  1. MAKEPROC ; Patch 8: This call will attempt to compute PROCEDURE field ^ (#6) PROCEDURE [8F]
  1. ; from Fields: (#41) CLASS [2P] or PACKAGE field (#40) PACKAGE [1S]
  1. ; Call assumes the FM FDA Array MAGGFDA exists.
  1. ; We are here because TYPE INDEX, CLASS INDEX and PACKAGE INDEX exist but PROCEDURE doesn't
  1. ; Calling RTN expects MAGERR to exist if error. ;
  1. N TYPE,CLS,PKG
  1. I $G(MAGGFDA(2005,"+1,",40),"NONE")'="NONE" S MAGGFDA(2005,"+1,",6)=MAGGFDA(2005,"+1,",40) Q
  1. S TYPE=$G(MAGGFDA(2005,"+1,",42))
  1. ; Can't make Type required. yet.
  1. S CLS=$P(^MAG(2005.83,TYPE,0),U,2)
  1. I 'CLS S MAGERR="0^Missing Class pointer for TYPE : "_$P(^MAG(2005.83,TYPE,0),U)_" ("_TYPE_")" Q
  1. S MAGGFDA(2005,"+1,",6)=$P($$GET1^DIQ(2005.82,CLS,".01","E"),"/")
  1. Q
  1. MAKEORIG ; Patch 8: This call will default the Origin field #45 to "VA"
  1. ; We are here because TYPE exists in the Array but Origin doesn't
  1. S MAGGFDA(2005,"+1,",45)="V" ; Patch 108: set to "V"
  1. Q
  1. KILLENT(MAGGDA) ; Delete the entry just created, because of Post processing Error
  1. D CLEAN^DILF
  1. S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
  1. K DA,DIC,DIK
  1. Q
  1. RTRNERR(ETXT,MAGGXE) ; There was error from UPDATE^DIE quit with error text
  1. S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
  1. Q
  1. PHOTODA() ;Return the DA from File IMAGE INDEX FOR TYPES that is the PhotoID entry.
  1. Q $O(^MAG(2005.83,"B","PHOTO ID",""))