source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIU1.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1MAGGSIU1 ;WOIFO/GEK - Utilities for Image Add/Modify ; [ 12/27/2000 10:49 ]
2 ;;3.0;IMAGING;**7,8**;Sep 15, 2004
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20 ; GEK 11/04/2002 Keep MAGGTU1 as utility for DA2NAME and DRIVE
21 ;
22MAKENAME(MAGGFDA) ; get info from the MAGGFDA array
23 ; For all Images the Name (.01) is first 18 characters of patient name
24 ; concatenated with SSN.
25 ; If No patient name is sent, well make the name from the short desc.
26 ; We were making name of :
27 ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
28 N ZDESC,X
29 S ZDESC=""
30 ; If we don't have a patient name ( later) we set .01 to Short Desc
31 ; if it exists.
32 I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
33 ; DFN
34 I $D(MAGGFDA(2005,"+1,",5)) D
35 . S X=MAGGFDA(2005,"+1,",5)
36 . ; NAME SSN
37 . S ZDESC=$E($P(^DPT(X,0),U),1,18)_" "_$P(^DPT(X,0),U,9)
38 ;
39 Q ZDESC
40MAKECLAS ; Patch 8: This call will attempt to compute an Image CLASS ^ (#41) CLASS [2P]
41 ; from the TYPE Field (#42) TYPE [3P]
42 ; Call assumes the FM FDA Array MAGGFDA exists.
43 ;// Note : this is also called from MAGGTIA. TYPE may not exist.
44 ; Calling RTN expects MAGERR to exist if error.
45 N TYPE,CLS
46 S TYPE=$G(MAGGFDA(2005,"+1,",42))
47 ; Can't make Type required. yet.
48 ;I TYPE="" S MAGERR="0^A Value for Field #42 (Image Type) is missing." Q
49 I TYPE="" Q
50 S CLS=$P(^MAG(2005.83,TYPE,0),U,2)
51 I 'CLS S MAGERR="0^Missing Class pointer for TYPE : "_$P(^MAG(2005.83,TYPE,0),U)_" ("_TYPE_")" Q
52 S MAGGFDA(2005,"+1,",41)=CLS
53 Q
54MAKEPKG ;Patch 8 This call will attempt to compute the field (#40) PACKAGE INDEX [1S] from Patent Data File.
55 ; Call assumes the FM FDA Array MAGGFDA exists.
56 N PARENT,PKG,PXIEN,MAGRY,OK,TYPE
57 S PARENT=$G(MAGGFDA(2005,"+1,",16))
58 S TYPE=$G(MAGGFDA(2005,"+1,",42))
59 I (PARENT="")&(TYPE=$$PHOTODA) D Q
60 . S MAGGFDA(2005,"+1,",40)="PHOTOID"
61 . ; Need next line, bacause the Method that returns Photo ID for a Pat.
62 . ; checks for PHOTO ID in the Cross Reference.
63 . S MAGGFDA(2005,"+1,",6)="PHOTO ID"
64 . Q
65 I PARENT="" S MAGGFDA(2005,"+1,",40)="NONE" Q ;MAGERR="0^Missing Parent Data File pointer" Q
66 I PARENT'=8925 S PKG=$P(^MAG(2005.03,PARENT,2),U) Q
67 S PXIEN=$G(MAGGFDA(2005,"+1,",17))
68 D DATA^MAGGNTI(.MAGRY,PXIEN)
69 D ISCP^TIUCP(.OK,$P(MAGRY,U,2)) I OK S MAGGFDA(2005,"+1,",40)="CP" Q
70 D ISCNSLT^TIUCNSLT(.OK,$P(MAGRY,U,2)) I OK S MAGGFDA(2005,"+1,",40)="CONS" Q
71 S MAGGFDA(2005,"+1,",40)="NOTE"
72 Q
73MAKEPROC ; Patch 8: This call will attempt to compute PROCEDURE field ^ (#6) PROCEDURE [8F]
74 ; from Fields: (#41) CLASS [2P] or PACKAGE field (#40) PACKAGE [1S]
75 ; Call assumes the FM FDA Array MAGGFDA exists.
76 ; We are here because TYPE INDEX, CLASS INDEX and PACKAGE INDEX exist but PROCEDURE doesn't
77 ; Calling RTN expects MAGERR to exist if error. ;
78 N TYPE,CLS,PKG
79 I $G(MAGGFDA(2005,"+1,",40),"NONE")'="NONE" S MAGGFDA(2005,"+1,",6)=MAGGFDA(2005,"+1,",40) Q
80 S TYPE=$G(MAGGFDA(2005,"+1,",42))
81 ; Can't make Type required. yet.
82 S CLS=$P(^MAG(2005.83,TYPE,0),U,2)
83 I 'CLS S MAGERR="0^Missing Class pointer for TYPE : "_$P(^MAG(2005.83,TYPE,0),U)_" ("_TYPE_")" Q
84 S MAGGFDA(2005,"+1,",6)=$P($$GET1^DIQ(2005.82,CLS,".01","E"),"/")
85 Q
86MAKEORIG ; Patch 8: This call will default the Origin field #45 to "VA"
87 ; We are here because TYPE exists in the Array but Origin doesn't
88 S MAGGFDA(2005,"+1,",45)="VA"
89 Q
90KILLENT(MAGGDA) ; Delete the entry just created, because of Post processing Error
91 D CLEAN^DILF
92 S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
93 K DA,DIC,DIK
94 Q
95RTRNERR(ETXT,MAGGXE) ; There was error from UPDATE^DIE quit with error text
96 S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
97 Q
98PHOTODA() ;Return the DA from File IMAGE INDEX FOR TYPES that is the PhotoID entry.
99 Q $O(^MAG(2005.83,"B","PHOTO ID",""))
Note: See TracBrowser for help on using the repository browser.