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