Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m
r613 r623 1 MAGGSIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,8,85,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 11 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 Q 20 PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ; 21 ; Check on some possible problems: required fields etc. 22 ; Object Type and (Patient, or Short Desc) Required. 23 N MAGRSLT,X,Z 24 I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE 25 I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q 26 I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D Q 27 . S MAGERR="0^Need Patient or Short Desc. Operation CANCELED " 28 ; IF no Procedure text we'll give it some so crossref will set. 29 D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q 30 ; Patch 8 IAPI We Create IXCLS (#41 CLASS) and IXPKG (#40 Package) if TYPE is in Data. 31 ; But we are not making TYPE required yet for backward compatibality. 32 I $D(MAGGFDA(2005,"+1,",42)) D 33 . I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D S MAGRY=MAGERR Q 34 . . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE" 35 . I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 36 . I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D S MAGRY=MAGERR Q 37 . . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image." 38 . I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 39 . I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 40 . I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 41 . Q 42 ; 43 I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT 44 ; 45 ; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW 46 I '$D(MAGGFDA(2005,"+1,",15)) D 47 . I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q 48 . S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12) 49 ; DateTime image saved. 50 I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12) 51 ; Short Description 52 ;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA) 53 I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6)) 54 ; Name (.01) 55 I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA) 56 I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ) 57 ; Acquisition Site, Use it to tell where to save the file. 58 I $D(MAGACT("ACQS")) D 59 . ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05 60 . I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";") 61 ; Only get drive:dir if not a group 62 I 'MAGGRP D I $L(MAGERR) Q 63 . ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location 64 . ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code) 65 . S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"") 66 . ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = "" 67 . ; 68 . S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write 69 . I 'Z S MAGERR=Z Q 70 . S MAGGDRV=$P(Z,U,2) 71 . S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic 72 . ; if a big file is being made on workstation, put NetWork Location 73 . ; pointer in the BIG NETWORK LOCATION field. 74 . ; (BIG files default to same Network Location as FullRes (or PACS)) 75 . I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z 76 . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1 77 . I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z 78 ; 79 I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL") 80 ; HERE we are putting PRE Processing for the Import API action codes. 81 ; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it. 82 I $D(MAGACT("ACQD")) D 83 . ; IF Value is a pointer to the ACQ DEVICE File Quit. If it's invalid then UPDATE will catch it. 84 . I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q 85 . I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D Q 86 . . ; IF Already exists, add it to the FDA 87 . . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),"")) 88 . . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ? 89 . . ; ?? 90 . ; IF it doesn't exist, create it, and add it's ien to the image entry 91 . N MAGDFDA,MAGDIEN,MAGDXE 92 . S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD") 93 . S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05))) 94 . 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)) 95 . ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece 96 . ; now it is sent as it's own value in ACQL 97 . D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE") 98 . S MAGGFDA(2005,"+1,",107)=MAGDIEN(1) 99 ; 100 ; Check the last entry in Audit File to see if it is greater than 101 ; last image in Image File. IF yes, change Image File (0) node entry. 102 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) 103 ; 104 Q 105 PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient 106 ; 107 N MAGDFN,PX,PXDA,MAGY 108 S PX=$G(MAGGFDA(2005,"+1,",16)) 109 S PXDA=$G(MAGGFDA(2005,"+1,",17)) 110 I 'PX S MAGR=1 Q ; This is a category, or an Image of a group (no parent pointer) 111 S MAGDFN=MAGGFDA(2005,"+1,",5) 112 I (PX=8925) D Q 113 . I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q 114 . D DATA^MAGGNTI(.MAGY,PXDA) 115 . I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q 116 . S MAGR=1 117 Q 118 OBJTYPE ; This call uses the EXT and computes an Object Type 119 N MTYPE 120 I '$L($G(MAGACT("EXT"))) Q 121 S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),"")) 122 ;I 'MTYPE Q 123 ;TODO : Answer question, do we want to have a default Image type ? 124 I 'MTYPE S MTYPE=1 125 S MAGGFDA(2005,"+1,",3)=MTYPE 126 Q 127 ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type 128 N CL 129 I '$G(TYPE) Q 0 130 S CL=$$GET1^DIQ(2005.83,TYPE,1,"E") 131 Q $S($E(CL,1,5)="ADMIN":1,1:0) 132 PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F] 133 ; We are here because fld #6 PROCEDURE [8F] is null. 134 ; If a pointer to a package is in the data, (flds 16 and 17) 135 ; get fld #6 from that , if not then treat it as an UNASSIGNED image 136 ; i.e. Category UNASSIGNED. 137 N MAGYPX,PARENT,PARIEN,PXDESC 138 S PARENT=$G(MAGGFDA(2005,"+1,",16)) 139 S PARIEN=$G(MAGGFDA(2005,"+1,",17)) 140 ; 141 I (PARENT=8925),(PARIEN]"") D Q 142 . D DATA^MAGGNTI(.MAGYPX,PARIEN) 143 . S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2) 144 ;TODO; create calls to get default procedure desc for all specialties 145 ; AND default to NONE if a TYPE and no PARENT data File (fld 16) 146 ; If a Parent pointer exists, and it isn't TIU, for now set "NO Description" 147 I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q 148 ; 149 ; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY 150 I ($G(MAGGFDA(2005,"+1,",100))]"") D Q 151 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1) 152 ; 153 ; If a new child of a Group, use that Proc Desc 154 I $G(MAGGFDA(2005,"+1,",14))]"" D Q 155 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8) 156 ; 157 ; Parent="", and no Category pointer, then we Call it UNASSIGNED 158 S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED","")) 159 S MAGGFDA(2005,"+1,",6)="UNASSIGNED" 160 Q 1 MAGGSIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,8,85**;16-March-2007;;Build 1039 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 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 PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ; 20 ; Check on some possible problems: required fields etc. 21 ; Object Type and (Patient, or Short Desc) Required. 22 N MAGRSLT,X,Z 23 I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE 24 I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q 25 I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D Q 26 . S MAGERR="0^Need Patient or Short Desc. Operation CANCELED " 27 ; IF no Procedure text we'll give it some so crossref will set. 28 D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q 29 ; Patch 8 IAPI We Create IXCLS (#41 CLASS) and IXPKG (#40 Package) if TYPE is in Data. 30 ; But we are not making TYPE required yet for backward compatibality. 31 I $D(MAGGFDA(2005,"+1,",42)) D 32 . I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D S MAGRY=MAGERR Q 33 . . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE" 34 . I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 35 . I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D S MAGRY=MAGERR Q 36 . . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image." 37 . I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 38 . I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 39 . I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q 40 . Q 41 ; 42 I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT 43 ; 44 ; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW 45 I '$D(MAGGFDA(2005,"+1,",15)) D 46 . I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q 47 . S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12) 48 ; DateTime image saved. 49 I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12) 50 ; Short Description 51 ;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA) 52 I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6)) 53 ; Name (.01) 54 I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA) 55 I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ) 56 ; Acquisition Site, Use it to tell where to save the file. 57 I $D(MAGACT("ACQS")) D 58 . ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05 59 . I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";") 60 ; Only get drive:dir if not a group 61 I 'MAGGRP D I $L(MAGERR) Q 62 . ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location 63 . ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code) 64 . S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"") 65 . ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = "" 66 . ; 67 . S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write 68 . I 'Z S MAGERR=Z Q 69 . S MAGGDRV=$P(Z,U,2) 70 . S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic 71 . ; if a big file is being made on workstation, put NetWork Location 72 . ; pointer in the BIG NETWORK LOCATION field. 73 . ; (BIG files default to same Network Location as FullRes (or PACS)) 74 . I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z 75 . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1 76 . I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z 77 ; 78 I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL") 79 ; HERE we are putting PRE Processing for the Import API action codes. 80 ; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it. 81 I $D(MAGACT("ACQD")) D 82 . ; IF Value is a pointer to the ACQ DEVICE File Quit. If it's invalid then UPDATE will catch it. 83 . I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q 84 . I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D Q 85 . . ; IF Already exists, add it to the FDA 86 . . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),"")) 87 . . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ? 88 . . ; ?? 89 . ; IF it doesn't exist, create it, and add it's ien to the image entry 90 . N MAGDFDA,MAGDIEN,MAGDXE 91 . S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD") 92 . S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05))) 93 . 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)) 94 . ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece 95 . ; now it is sent as it's own value in ACQL 96 . D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE") 97 . S MAGGFDA(2005,"+1,",107)=MAGDIEN(1) 98 ; 99 ; Check the last entry in Audit File to see if it is greater than 100 ; last image in Image File. IF yes, change Image File (0) node entry. 101 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) 102 ; 103 Q 104 PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient 105 ; 106 N MAGDFN,PX,PXDA,MAGY 107 S PX=$G(MAGGFDA(2005,"+1,",16)) 108 S PXDA=$G(MAGGFDA(2005,"+1,",17)) 109 I 'PX S MAGR=1 Q ; This is a category, or an Image of a group (no parent pointer) 110 S MAGDFN=MAGGFDA(2005,"+1,",5) 111 I (PX=8925) D Q 112 . I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q 113 . D DATA^MAGGNTI(.MAGY,PXDA) 114 . I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q 115 . S MAGR=1 116 Q 117 OBJTYPE ; This call uses the EXT and computes an Object Type 118 N MTYPE 119 I '$L($G(MAGACT("EXT"))) Q 120 S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),"")) 121 ;I 'MTYPE Q 122 ;TODO : Answer question, do we want to have a default Image type ? 123 I 'MTYPE S MTYPE=1 124 S MAGGFDA(2005,"+1,",3)=MTYPE 125 Q 126 ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type 127 N CL 128 I '$G(TYPE) Q 0 129 S CL=$$GET1^DIQ(2005.83,TYPE,1,"E") 130 Q $S($E(CL,1,5)="ADMIN":1,1:0) 131 PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F] 132 ; We are here because fld #6 PROCEDURE [8F] is null. 133 ; If a pointer to a package is in the data, (flds 16 and 17) 134 ; get fld #6 from that , if not then treat it as an UNASSIGNED image 135 ; i.e. Category UNASSIGNED. 136 N MAGYPX,PARENT,PARIEN,PXDESC 137 S PARENT=$G(MAGGFDA(2005,"+1,",16)) 138 S PARIEN=$G(MAGGFDA(2005,"+1,",17)) 139 ; 140 I (PARENT=8925),(PARIEN]"") D Q 141 . D DATA^MAGGNTI(.MAGYPX,PARIEN) 142 . S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2) 143 ;TODO; create calls to get default procedure desc for all specialties 144 ; AND default to NONE if a TYPE and no PARENT data File (fld 16) 145 ; If a Parent pointer exists, and it isn't TIU, for now set "NO Description" 146 I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q 147 ; 148 ; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY 149 I ($G(MAGGFDA(2005,"+1,",100))]"") D Q 150 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1) 151 ; 152 ; If a new child of a Group, use that Proc Desc 153 I $G(MAGGFDA(2005,"+1,",14))]"" D Q 154 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8) 155 ; 156 ; Parent="", and no Category pointer, then we Call it UNASSIGNED 157 S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED","")) 158 S MAGGFDA(2005,"+1,",6)="UNASSIGNED" 159 Q
Note:
See TracChangeset
for help on using the changeset viewer.
