| [613] | 1 | MAGGSIU1 ;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 | ;
|
|---|
| 22 | MAKENAME(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
|
|---|
| 40 | MAKECLAS ; 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
|
|---|
| 54 | MAKEPKG ;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
|
|---|
| 73 | MAKEPROC ; 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
|
|---|
| 86 | MAKEORIG ; 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
|
|---|
| 90 | KILLENT(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
|
|---|
| 95 | RTRNERR(ETXT,MAGGXE) ; There was error from UPDATE^DIE quit with error text
|
|---|
| 96 | S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
|
|---|
| 97 | Q
|
|---|
| 98 | PHOTODA() ;Return the DA from File IMAGE INDEX FOR TYPES that is the PhotoID entry.
|
|---|
| 99 | Q $O(^MAG(2005.83,"B","PHOTO ID",""))
|
|---|
