Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNTI.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNTI.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNTI.m
r613 r623 1 MAGGNTI ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 04 Apr 2002 2:37 PM 2 ;;3.0;IMAGING;**10,8,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 ;; | 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 FILE(MAGRY,MAGDA,TIUDA) ;RPC [MAG3 TIU IMAGE] 20 ; Call to file TIU and Imaging Pointers 21 ; TIU API to add image to TIU 22 N X 23 I $P(^TIU(8925,TIUDA,0),U,2)'=$P(^MAG(2005,MAGDA,0),U,7) S MAGRY="0^Patient Mismatch." Q 24 D PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA) ; 25 I 'MAGRY Q 26 ; Now SET the Parent fields in the Image File 27 S $P(^MAG(2005,MAGDA,2),U,6,8)=8925_U_TIUDA_U_+MAGRY 28 ; DONE. 29 S MAGRY="1^Image pointer filed successfully" 30 ; Now we save the PARENT ASSOCIATION Date/Time 31 D LINKDT^MAGGTU6(.X,MAGDA) 32 Q 33 DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA] 34 ; Call to get TIU data from the TIUDA 35 ; Return = TIUDA^Document Type ^Document Date^DFN^Author DUZ 36 ; 37 S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I")_U_$$GET1^DIQ(8925,TIUDA,"1202","I")_U 38 Q 39 IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE] 40 ; Call to get all images for a given TIU DA 41 ; We first get all Image IEN's breaking groups into separate images 42 ; Then get Image Info for each one. 43 ; MAGRY - Return array of Image Data entries 44 ; MAGRY(0) is 1 ^ message if successful 45 ; 0 ^ Error message if error; 46 ; TIUDA is IEN in ^TIU(8925 47 ; 48 ; Call TIU API to get list of Image IEN's 49 N MAGARR,CT,TCT,I,J,Z K ^TMP($J,"MAGGX") 50 N DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT 51 N TIUDFN,MAGQUIT ; MAGQI 8/22/01 52 ; MAGFILE is returned from MAGGTII 53 ; 54 S MAGQUIT=0 ; MAGQI 8/22/01 55 S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) ;MAGQI 8/22/01 56 I 'TIUDFN S MAGRY(0)="0^Invalid Patient DFN for Note ID: '"_TIUDA_"'" 57 D GETILST^TIUSRVPL(.MAGARR,TIUDA) 58 S CT=0,TCT=0 59 ; Now get all images for all groups and single images. 60 S I="" F S I=$O(MAGARR(I)) Q:'I S DA=MAGARR(I) D ;Q:MAGQUIT 61 . S Z=$$ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_Z Q 62 . ; Check that array of images from selected TIUDA have 63 . ; same patient's and valid backward pointers 64 . I $P($G(^MAG(2005,DA,0)),U,7)'=TIUDFN S MAGQUIT=1,MAGNCHK="Patient Mismatch. TIU: "_TIUDA 65 . I $P($G(^MAG(2005,DA,2)),U,7)'=TIUDA S MAGQUIT=1,MAGNCHK="Pointer Mismatch. TIU: "_TIUDA 66 . I MAGQUIT S MAGXX=DA D INFO^MAGGTII D Q 67 . . ; remove the Abstract and Image File Names ; 2/14/03 p8t14 remove c:\program files. with .\bmp\ 68 . . S $P(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp" 69 . . ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE 70 . . S $P(MAGFILE,U,6)=$S(($P(MAGFILE,U,6)'=11):"99",1:11) 71 . . S $P(MAGFILE,U,10)="M" 72 . . ;Send the error message 73 . . S $P(MAGFILE,U,17)=MAGNCHK 74 . . S TCT=TCT+1,MAGRY(TCT)="B2^"_MAGFILE 75 . ; 76 . I $O(^MAG(2005,DA,1,0)) D Q 77 . . ; Integrity check, if group is questionable, add it's ien to list, not it's 78 . . ; children. Later when list is looped through, it's INFO^MAGGTII will be in 79 . . ; list. Have to do this to allow other images in list from TIU to be processed. 80 . . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP($J,"MAGGX",CT)=DA Q 81 . . S J=0 ; the following line needs to take only the first piece of the node - PMK 4/4/02 82 . . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP($J,"MAGGX",CT)=$P(^(J,0),"^") 83 . S CT=CT+1 84 . S ^TMP($J,"MAGGX",CT)=DA 85 ; Now get image info for each image 86 ; 87 S Z="" 88 S MAGQUIET=1 89 F S Z=$O(^TMP($J,"MAGGX",Z)) Q:Z="" D 90 . S TCT=TCT+1,MAGXX=^TMP($J,"MAGGX",Z) 91 . ;GEK 8/24/00 Stopping the Invalid Image IEN's and Deleted Images 92 . I '$D(^MAG(2005,MAGXX)) D Q 93 . . D INVALID^MAGGTIG(MAGXX,.MAGRSLT) S MAGRY(CT)=MAGRSLT 94 . D INFO^MAGGTII 95 . S MAGRY(TCT)="B2^"_MAGFILE 96 K MAGQUIET 97 S MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE" 98 ; Put the Image IEN of the last image into the group IEN field. 99 Q:'TCT 100 S $P(MAGRY(0),U,3)=TIUDA 101 K MAGRSLT 102 D DATA(.MAGRSLT,TIUDA) 103 S $P(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$P(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($P(MAGRSLT,U,3),"8") 104 ; 105 S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U),$G(MAGXX):MAGXX,1:0) 106 Q 107 ;. S Z=ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_$P(Z,U,2) Q 108 ISDELIMG(MAGIEN) ; Is this a deleted Image. 109 N MAGDEL,MAGIMG,MAGR,Z,MAGT 110 S MAGDEL=$D(^MAG(2005.1,MAGIEN)) 111 S MAGIMG=$D(^MAG(2005,MAGIEN)) 112 I MAGIMG,'MAGDEL S MAGR="0^Valid Image" 113 I 'MAGIMG,MAGDEL S MAGR="1^Deleted Image",MAGT=66 114 I 'MAGIMG,'MAGDEL S MAGR="1^Invalid Image pointer",MAGT=67 115 I MAGIMG,MAGDEL S MAGR="0^Image IEN exists, and is Deleted !" 116 I 'MAGR Q MAGR 117 S MAGR=$P(MAGR,U,2) 118 S $P(Z,U,1,4)=MAGIEN_"^-1~"_MAGR_"^-1~"_MAGR_"^"_MAGR 119 S $P(Z,U,6)=MAGT 120 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE 121 S $P(Z,U,10)="M" 122 ;Send the error message 123 S $P(Z,U,17)=$P(MAGR,U,2) 124 Q Z 125 ISDOCCL(MAGRY,IEN,TIUFILE,CLASS) ;RPC [MAGG IS DOC CLASS] 126 ;Checks to see if IEN of TIU Files 8925 or 8925.1 is of a certain Doc Class 127 ;MAGRY = Return String 128 ; for Success "1^message" 129 ; for Failure "0^message" 130 ;IEN = Internal Entry Number in the TIUFILE 131 ;TIUFILE = either 8925 if we need to see if a Note is of a Document Class 132 ; or 8925.1 if we need to see if a Title is of a Document Class 133 ;CLASS = Text Name of the Document Class example: "ADVANCE DIRECTIVE" 134 ; 135 S MAGRY="0^Unknown Error checking TIU Document Class" 136 K MAGTRGT,DEFIEN,DOCCL,RES,DONE,NTTL 137 S DONE=0 138 ; If we're resolving a Title 139 I TIUFILE="8925.1" D Q:DONE 140 . S DEFIEN=IEN,NTTL="Title" 141 . I '$D(^TIU(8925.1,DEFIEN,0)) S MAGRY="0^Invalid Title IEN",DONE=1 Q 142 . Q 143 ; If we're resolving a Note 144 I TIUFILE="8925" D Q:DONE 145 . S NTTL="Note" 146 . I '$D(^TIU(8925,IEN)) S MAGRY="0^Invalid Note IEN",DONE=1 Q 147 . ; Get Title IEN from Note IEN 148 . S DEFIEN=$$GET1^DIQ(8925,IEN_",",.01,"I") 149 . I DEFIEN="" S MAGRY="0^Error resolving Document Class from Note IEN" S DONE=1 Q 150 . Q 151 ; 152 ; Find the IEN in 8925.1 for Document Class (CLASS) 153 D FIND^DIC(8925.1,"","@;.001","X",CLASS,"","","I $P(^(0),U,4)=""DC""","","MAGTRGT") 154 S DOCCL=$G(MAGTRGT("DILIST",2,1)) 155 ; 156 ; See if ^TIU(8925.1,DEFIEN is of Document Class DOCCL 157 S RES=$$ISA^TIULX(DEFIEN,DOCCL) 158 I RES S MAGRY="1^The "_NTTL_" is of Document Class "_CLASS Q 159 S MAGRY="0^The "_NTTL_" is Not of Document Class "_CLASS 160 Q 1 MAGGNTI ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 04 Apr 2002 2:37 PM 2 ;;3.0;IMAGING;**10,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 FILE(MAGRY,MAGDA,TIUDA) ;RPC [MAG3 TIU IMAGE] 20 ; Call to file TIU and Imaging Pointers 21 ; TIU API to add image to TIU 22 I $P(^TIU(8925,TIUDA,0),U,2)'=$P(^MAG(2005,MAGDA,0),U,7) S MAGRY="0^Patient Mismatch." Q 23 D PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA) ; 24 I 'MAGRY Q 25 ; Now SET the Parent fields in the Image File 26 S $P(^MAG(2005,MAGDA,2),U,6,8)=8925_U_TIUDA_U_+MAGRY 27 ; DONE. 28 S MAGRY="1^Image pointer filed successfully" 29 Q 30 DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA] 31 ; Call to get TIU data from the TIUDA 32 ; Return = TIUDA^Document Type ^Document Date^DFN 33 ; 34 S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I") 35 Q 36 IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE] 37 ; Call to get all images for a given TIU DA 38 ; We first get all Image IEN's breaking groups into seperate images 39 ; Then get Image Info for each one. 40 ; MAGRY - Return array of Image Data entries 41 ; MAGRY(0) is 1 ^ message if successful 42 ; 0 ^ Error message if error; 43 ; TIUDA is IEN in ^TIU(8925 44 ; 45 ; Call TIU API to get list of Image IEN's 46 N MAGARR,CT,TCT K ^TMP("MAGGX",$J) 47 N DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT 48 N TIUDFN,MAGQUIT ; MAGQI 8/22/01 49 ; MAGFILE is returned from MAGGTII 50 ; 51 S MAGQUIT=0 ; MAGQI 8/22/01 52 S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) ;MAGQI 8/22/01 53 I 'TIUDFN S MAGRY(0)="0^Invalid Patient DFN for Note ID: '"_TIUDA_"'" 54 D GETILST^TIUSRVPL(.MAGARR,TIUDA) 55 S CT=0,TCT=0 56 ; Now get all images for all groups and single images. 57 S I="" F S I=$O(MAGARR(I)) Q:'I S DA=MAGARR(I) D ;Q:MAGQUIT 58 . S Z=$$ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_Z Q 59 . ; Check that array of images from selected TIUDA have 60 . ; same patient's and valid backward pointers 61 . I $P($G(^MAG(2005,DA,0)),U,7)'=TIUDFN S MAGQUIT=1,MAGNCHK="Patient Mismatch. TIU: "_TIUDA 62 . I $P($G(^MAG(2005,DA,2)),U,7)'=TIUDA S MAGQUIT=1,MAGNCHK="Pointer Mismatch. TIU: "_TIUDA 63 . I MAGQUIT S MAGXX=DA D INFO^MAGGTII D Q 64 . . ; remove the Abstract and Image File Names ; 2/14/03 p8t14 remove c:\program files. with .\bmp\ 65 . . S $P(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp" 66 . . ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE 67 . . S $P(MAGFILE,U,6)=$S(($P(MAGFILE,U,6)'=11):"99",1:11) 68 . . S $P(MAGFILE,U,10)="M" 69 . . ;Send the error message 70 . . S $P(MAGFILE,U,17)=MAGNCHK 71 . . S TCT=TCT+1,MAGRY(TCT)="B2^"_MAGFILE 72 . ; 73 . I $O(^MAG(2005,DA,1,0)) D Q 74 . . ; Integrity check, if group is questionable, add it's ien to list, not it's 75 . . ; children. Later when list is looped through, it's INFO^MAGGTII will be in 76 . . ; list. Have to do this to allow other images in list from TIU to be processed. 77 . . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP("MAGGX",$J,CT)=DA Q 78 . . S J=0 ; the following line needs to take only the first piece of the node - PMK 4/4/02 79 . . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP("MAGGX",$J,CT)=$P(^(J,0),"^") 80 . S CT=CT+1 81 . S ^TMP("MAGGX",$J,CT)=DA 82 ; Now get image info for each image 83 ; 84 S Z="" 85 S MAGQUIET=1 86 F S Z=$O(^TMP("MAGGX",$J,Z)) Q:Z="" D 87 . S TCT=TCT+1,MAGXX=^TMP("MAGGX",$J,Z) 88 . ;GEK 8/24/00 Stoping the Invalid Image IEN's and Deleted Images 89 . I '$D(^MAG(2005,MAGXX)) D Q 90 . . D INVALID^MAGGTIG(MAGXX,.MAGRSLT) S MAGRY(CT)=MAGRSLT 91 . D INFO^MAGGTII 92 . S MAGRY(TCT)="B2^"_MAGFILE 93 K MAGQUIET 94 S MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE" 95 ; PUT THE Image IEN of the last image into the group ien field. 96 Q:'TCT 97 S $P(MAGRY(0),U,3)=TIUDA 98 K MAGRSLT 99 D DATA(.MAGRSLT,TIUDA) 100 S $P(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$P(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($P(MAGRSLT,U,3),"8") 101 ; 102 S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U),1:MAGXX) 103 Q 104 ;. S Z=ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_$P(Z,U,2) Q 105 ISDELIMG(MAGIEN) ; Is this a deleted Image. 106 N MAGDEL,MAGIMG,MAGR,Z,MAGT 107 S MAGDEL=$D(^MAG(2005.1,MAGIEN)) 108 S MAGIMG=$D(^MAG(2005,MAGIEN)) 109 I MAGIMG,'MAGDEL S MAGR="0^Valid Image" 110 I 'MAGIMG,MAGDEL S MAGR="1^Deleted Image",MAGT=66 111 I 'MAGIMG,'MAGDEL S MAGR="1^Invalid Image pointer",MAGT=67 112 I MAGIMG,MAGDEL S MAGR="0^Image IEN exists, and is Deleted !" 113 I 'MAGR Q MAGR 114 S MAGR=$P(MAGR,U,2) 115 S $P(Z,U,1,4)=MAGIEN_"^-1~"_MAGR_"^-1~"_MAGR_"^"_MAGR 116 S $P(Z,U,6)=MAGT 117 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE 118 S $P(Z,U,10)="M" 119 ;Send the error message 120 S $P(Z,U,17)=$P(MAGR,U,2) 121 Q Z
Note:
See TracChangeset
for help on using the changeset viewer.
