Index: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m
===================================================================
--- WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m	(revision 623)
@@ -1,160 +1,159 @@
-MAGGSIA1	;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ]
-	;;3.0;IMAGING;**7,8,85,59**;Nov 27, 2007;Build 20
-	;;Per VHA Directive 2004-038, this routine should not be modified.
-	;; +---------------------------------------------------------------+
-	;; | 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
-PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF)	;
-	;  Check on some possible problems: required fields etc.
-	;  Object Type and (Patient, or Short Desc) Required.
-	N MAGRSLT,X,Z
-	I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE
-	I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q
-	I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D  Q
-	. S MAGERR="0^Need Patient or Short Desc.  Operation CANCELED "
-	; IF no Procedure text we'll give it some so crossref will set.
-	D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q
-	; Patch 8 IAPI We Create IXCLS (#41 CLASS) and  IXPKG (#40 Package) if TYPE is in Data.
-	; But we are not making TYPE required yet for backward compatibality.
-	I $D(MAGGFDA(2005,"+1,",42)) D
-	. I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D  S MAGRY=MAGERR Q
-	. . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE"
-	. I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
-	. I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D  S MAGRY=MAGERR Q
-	. . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image."
-	. I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
-	. I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
-	. I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
-	. Q
-	;
-	I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT
-	;
-	; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW
-	I '$D(MAGGFDA(2005,"+1,",15)) D
-	. I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q
-	. S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12)
-	; DateTime image saved.
-	I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12)
-	; Short Description
-	;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
-	I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6))
-	; Name (.01)
-	I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
-	I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ)
-	; Acquisition Site, Use it to tell where to save the file.
-	I $D(MAGACT("ACQS")) D
-	. ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05
-	. I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";")
-	; Only get drive:dir if not a group
-	I 'MAGGRP D  I $L(MAGERR) Q
-	. ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location
-	. ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code)
-	. S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
-	. ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = ""
-	. ;
-	. S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write
-	. I 'Z S MAGERR=Z Q
-	. S MAGGDRV=$P(Z,U,2)
-	. S MAGGFDA(2005,"+1,",2)=+Z               ;Disk & Vol magnetic
-	. ; if a big file is being made on workstation, put NetWork Location
-	. ; pointer in the BIG NETWORK LOCATION field.
-	. ; (BIG files default to same Network Location as FullRes (or PACS))
-	. I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z
-	. S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1
-	. I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z
-	;
-	I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL")
-	; HERE we are putting PRE Processing for the Import API action codes.
-	; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it.
-	I $D(MAGACT("ACQD")) D
-	. ; IF Value is a pointer to the ACQ DEVICE File Quit.  If it's invalid then UPDATE will catch it.
-	. I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q
-	. I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D  Q
-	. . ; IF Already exists, add it to the FDA
-	. . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),""))
-	. . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ? 
-	. . ; ??
-	. ; IF it doesn't exist, create it, and add it's ien to the image entry 
-	. N MAGDFDA,MAGDIEN,MAGDXE
-	. S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD")
-	. S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05)))
-	. S MAGDFDA(2006.04,"+1,",2)=$S($D(MAGACT("ACQL")):MAGACT("ACQL"),$D(MAGGFDA(2005,"+1,",101)):MAGGFDA(2005,"+1,",101),1:$P($G(MAGACT("ACQS")),";",2))
-	. ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece
-	. ;   now it is sent as it's own value in ACQL
-	. D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE")
-	. S MAGGFDA(2005,"+1,",107)=MAGDIEN(1)
-	;
-	;  Check the last entry in Audit File to see if it is greater than 
-	; last image in Image File.  IF yes, change Image File (0) node entry.
-	I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
-	;
-	Q
-PATCHK(MAGR)	; This uses the FDA Array and checks the Imaging Patient against the Procedure patient
-	;
-	N MAGDFN,PX,PXDA,MAGY
-	S PX=$G(MAGGFDA(2005,"+1,",16))
-	S PXDA=$G(MAGGFDA(2005,"+1,",17))
-	I 'PX S MAGR=1 Q  ; This is a category, or an Image of a group (no parent pointer)
-	S MAGDFN=MAGGFDA(2005,"+1,",5)
-	I (PX=8925) D  Q
-	. I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q
-	. D DATA^MAGGNTI(.MAGY,PXDA)
-	. I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q
-	. S MAGR=1
-	Q
-OBJTYPE	; This call uses the EXT and computes an Object Type
-	N MTYPE
-	I '$L($G(MAGACT("EXT"))) Q
-	S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),""))
-	;I 'MTYPE Q
-	;TODO : Answer question, do we want to have a default Image type ?
-	I 'MTYPE S MTYPE=1
-	S MAGGFDA(2005,"+1,",3)=MTYPE
-	Q
-ISTYPADM(TYPE)	; Returns 1 if this is an Admin Type
-	N CL
-	I '$G(TYPE) Q 0
-	S CL=$$GET1^DIQ(2005.83,TYPE,1,"E")
-	Q $S($E(CL,1,5)="ADMIN":1,1:0)
-PROCTEXT	;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F]
-	; We are here because fld #6 PROCEDURE [8F] is null.
-	; If a pointer to a package is in the data, (flds 16 and 17)
-	;  get fld #6 from that , if not then treat it as an UNASSIGNED image 
-	; i.e. Category UNASSIGNED.
-	N MAGYPX,PARENT,PARIEN,PXDESC
-	S PARENT=$G(MAGGFDA(2005,"+1,",16))
-	S PARIEN=$G(MAGGFDA(2005,"+1,",17))
-	;
-	I (PARENT=8925),(PARIEN]"") D  Q
-	. D DATA^MAGGNTI(.MAGYPX,PARIEN)
-	. S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2)
-	;TODO; create calls to get default procedure desc for all specialties
-	; AND default to NONE if a TYPE and no PARENT data File (fld 16)
-	; If a Parent pointer exists, and it isn't TIU, for now set "NO Description"
-	I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q
-	;
-	; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY
-	I ($G(MAGGFDA(2005,"+1,",100))]"") D  Q
-	. S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1)
-	; 
-	; If a new child of a Group, use that Proc Desc
-	I $G(MAGGFDA(2005,"+1,",14))]"" D  Q
-	. S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8)
-	;
-	; Parent="", and no Category pointer, then we Call it UNASSIGNED
-	S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED",""))
-	S MAGGFDA(2005,"+1,",6)="UNASSIGNED"
-	Q
+MAGGSIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ]
+ ;;3.0;IMAGING;**7,8,85**;16-March-2007;;Build 1039
+ ;; Per VHA Directive 2004-038, this routine should not be modified.
+ ;; +---------------------------------------------------------------+
+ ;; | 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
+PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ;
+ ;  Check on some possible problems: required fields etc.
+ ;  Object Type and (Patient, or Short Desc) Required.
+ N MAGRSLT,X,Z
+ I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE
+ I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q
+ I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D  Q
+ . S MAGERR="0^Need Patient or Short Desc.  Operation CANCELED "
+ ; IF no Procedure text we'll give it some so crossref will set.
+ D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q
+ ; Patch 8 IAPI We Create IXCLS (#41 CLASS) and  IXPKG (#40 Package) if TYPE is in Data.
+ ; But we are not making TYPE required yet for backward compatibality.
+ I $D(MAGGFDA(2005,"+1,",42)) D
+ . I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D  S MAGRY=MAGERR Q
+ . . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE"
+ . I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
+ . I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D  S MAGRY=MAGERR Q
+ . . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image."
+ . I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
+ . I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
+ . I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
+ . Q
+ ;
+ I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT
+ ;
+ ; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW
+ I '$D(MAGGFDA(2005,"+1,",15)) D
+ . I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q
+ . S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12)
+ ; DateTime image saved.
+ I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12)
+ ; Short Description
+ ;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
+ I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6))
+ ; Name (.01)
+ I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
+ I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ)
+ ; Acquisition Site, Use it to tell where to save the file.
+ I $D(MAGACT("ACQS")) D
+ . ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05
+ . I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";")
+ ; Only get drive:dir if not a group
+ I 'MAGGRP D  I $L(MAGERR) Q
+ . ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location
+ . ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code)
+ . S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
+ . ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = ""
+ . ;
+ . S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write
+ . I 'Z S MAGERR=Z Q
+ . S MAGGDRV=$P(Z,U,2)
+ . S MAGGFDA(2005,"+1,",2)=+Z               ;Disk & Vol magnetic
+ . ; if a big file is being made on workstation, put NetWork Location
+ . ; pointer in the BIG NETWORK LOCATION field.
+ . ; (BIG files default to same Network Location as FullRes (or PACS))
+ . I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z
+ . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1
+ . I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z
+ ;
+ I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL")
+ ; HERE we are putting PRE Processing for the Import API action codes.
+ ; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it.
+ I $D(MAGACT("ACQD")) D
+ . ; IF Value is a pointer to the ACQ DEVICE File Quit.  If it's invalid then UPDATE will catch it.
+ . I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q
+ . I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D  Q
+ . . ; IF Already exists, add it to the FDA
+ . . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),""))
+ . . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ? 
+ . . ; ??
+ . ; IF it doesn't exist, create it, and add it's ien to the image entry 
+ . N MAGDFDA,MAGDIEN,MAGDXE
+ . S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD")
+ . S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05)))
+ . S MAGDFDA(2006.04,"+1,",2)=$S($D(MAGACT("ACQL")):MAGACT("ACQL"),$D(MAGGFDA(2005,"+1,",101)):MAGGFDA(2005,"+1,",101),1:$P($G(MAGACT("ACQS")),";",2))
+ . ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece
+ . ;   now it is sent as it's own value in ACQL
+ . D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE")
+ . S MAGGFDA(2005,"+1,",107)=MAGDIEN(1)
+ ;
+ ;  Check the last entry in Audit File to see if it is greater than 
+ ; last image in Image File.  IF yes, change Image File (0) node entry.
+ I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
+ ;
+ Q
+PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient
+ ;
+ N MAGDFN,PX,PXDA,MAGY
+ S PX=$G(MAGGFDA(2005,"+1,",16))
+ S PXDA=$G(MAGGFDA(2005,"+1,",17))
+ I 'PX S MAGR=1 Q  ; This is a category, or an Image of a group (no parent pointer)
+ S MAGDFN=MAGGFDA(2005,"+1,",5)
+ I (PX=8925) D  Q
+ . I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q
+ . D DATA^MAGGNTI(.MAGY,PXDA)
+ . I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q
+ . S MAGR=1
+ Q
+OBJTYPE ; This call uses the EXT and computes an Object Type
+ N MTYPE
+ I '$L($G(MAGACT("EXT"))) Q
+ S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),""))
+ ;I 'MTYPE Q
+ ;TODO : Answer question, do we want to have a default Image type ?
+ I 'MTYPE S MTYPE=1
+ S MAGGFDA(2005,"+1,",3)=MTYPE
+ Q
+ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type
+ N CL
+ I '$G(TYPE) Q 0
+ S CL=$$GET1^DIQ(2005.83,TYPE,1,"E")
+ Q $S($E(CL,1,5)="ADMIN":1,1:0)
+PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F]
+ ; We are here because fld #6 PROCEDURE [8F] is null.
+ ; If a pointer to a package is in the data, (flds 16 and 17)
+ ;  get fld #6 from that , if not then treat it as an UNASSIGNED image 
+ ; i.e. Category UNASSIGNED.
+ N MAGYPX,PARENT,PARIEN,PXDESC
+ S PARENT=$G(MAGGFDA(2005,"+1,",16))
+ S PARIEN=$G(MAGGFDA(2005,"+1,",17))
+ ;
+ I (PARENT=8925),(PARIEN]"") D  Q
+ . D DATA^MAGGNTI(.MAGYPX,PARIEN)
+ . S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2)
+ ;TODO; create calls to get default procedure desc for all specialties
+ ; AND default to NONE if a TYPE and no PARENT data File (fld 16)
+ ; If a Parent pointer exists, and it isn't TIU, for now set "NO Description"
+ I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q
+ ;
+ ; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY
+ I ($G(MAGGFDA(2005,"+1,",100))]"") D  Q
+ . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1)
+ ; 
+ ; If a new child of a Group, use that Proc Desc
+ I $G(MAGGFDA(2005,"+1,",14))]"" D  Q
+ . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8)
+ ;
+ ; Parent="", and no Category pointer, then we Call it UNASSIGNED
+ S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED",""))
+ S MAGGFDA(2005,"+1,",6)="UNASSIGNED"
+ Q
