Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD2.m
r613 r623 1 MAGJUPD2 ;WIRMFO/JHC VistaRad RPCs-Update PS & KEY Img ; 14 July 2004 10:05 AM 2 ;;3.0;IMAGING;**18,76**;Jun 22, 2007;Build 19 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 ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR 21 D @^%ZOSF("ERRTN") 22 Q:$Q 1 Q 23 ; 24 SAVKPS(RARPT,INTERPFL,DATA,REPLY) ; Save study data: Key/Interpretation Images & Pres. State 25 ; RARPT--exam pointer 26 ; INTERPFL--1/0; 1=This is associated with a Rad Interpretation; Optional 27 ; DATA--array of input data; see structure at end of routine 28 ; REPLY--return string 29 N PSTRAK,IDATA,IMGCT,PSTOT,PSLINCT,PSKILCT,KEYCT,INTCT,STUDY,LINE,NEWIMG,NEWPS 30 N IMGREF,IMGIEN,PSIEN,SAVOP,STIEN,TYPE,IMG,ICT,NEWIMG,INITSTDY,SEQNUM 31 S INTERPFL=+$G(INTERPFL) 32 S NEWIMG=0,NEWPS=0,IMGIEN="",PSIEN="",SEQNUM=0 33 S (IMGCT,PSTOT,PSLINCT,KEYCT,INTCT,PSKILCT)=0 34 S IMGREF="",SAVOP="NOOP" 35 I '$D(TIMESTMP) N TIMESTMP S TIMESTMP=$$NOW^XLFDT() 36 ; 1st, process input in DATA 37 S IDATA="" 38 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S LINE=DATA(IDATA) I LINE]"" D 39 . I LINE="*IMAGE" S NEWIMG=1 Q 40 . I LINE="*PS" S NEWPS=1 Q 41 . I $E(LINE,1,4)="*END" S (NEWIMG,NEWPS)=0 Q 42 . I NEWIMG D IMGINIT(LINE) S NEWIMG=0 Q ; Init storage for this Image 43 . I NEWPS D PSINIT(LINE) S NEWPS=0 Q ; Init storage for a PS 44 . D @(SAVOP_"(LINE)") 45 ; Now update the Study node info 46 S INITSTDY=$S(INTERPFL:"INIT_STUDY",1:"") 47 S STIEN=$$STUDYID("",RARPT,1,INITSTDY) 48 I $D(PSTRAK) S IMG="" D ; Update key imgs in Study node 49 . F S IMG=$O(PSTRAK(IMG)) Q:'IMG S NEWIMG=1,TYPE="" D 50 . . F S TYPE=$O(PSTRAK(IMG,TYPE)) Q:TYPE="" D 51 . . . F ICT=1:1:PSTRAK(IMG,TYPE,0) D SAVKIMG(IMG,PSTRAK(IMG,TYPE,ICT),TYPE,NEWIMG) S NEWIMG=0 52 SAVKPSZ ; 53 I IMGCT!PSTOT!PSLINCT!KEYCT!INTCT S REPLY="1~Saved: "_KEYCT_" Key Image"_$S(KEYCT-1:"s",1:"")_"; "_INTCT_" Interp Image"_$S(INTCT-1:"s",1:"")_"; " 54 I S REPLY=REPLY_PSLINCT_" PS line"_$S(PSLINCT-1:"s",1:"")_" for "_PSTOT_" PS"_$S(PSTOT-1:"s",1:"")_" for "_IMGCT_" Image"_$S(IMGCT-1:"s.",1:".") 55 I S:PSKILCT REPLY=REPLY_" Deleted: "_PSKILCT_" PS record"_$S(PSKILCT-1:"s",1:"")_"." 56 E I PSKILCT S REPLY="1~Deleted: "_PSKILCT_" PS record"_$S(PSKILCT-1:"s",1:"")_"." 57 E S REPLY="0~No Key Image/PS data was stored or deleted." 58 Q 59 ; 60 NOOP(X) Q ; do nothing/ skip erroneous input 61 ; 62 IMGINIT(LINE) ; Init storage space for an image ; inits some vars for the SAVE loop 63 N IEN 64 S IMGIEN="",IMGREF="" 65 S IEN=$P(LINE,U) 66 I IEN,$D(^MAG(2005,IEN,0)),'$D(^(1)) 67 E G IMGINITZ 68 S IMGIEN=IEN 69 S IMGREF=$NA(^MAG(2005,IMGIEN)) ; indirect ref used in psinit & savps 70 S IMGCT=IMGCT+1 71 IMGINITZ Q 72 ; 73 PSINIT(LINE) ; Init storage space for a Presentation State ; inits some vars for SAVE loop 74 ; input = PS_UID ^ UID Type (KEY, INT) ^ "DELETE" 75 ; if peice 3 ="DELETE" then the PS data is deleted 76 N IEN,UID,TYPE,DELETE 77 S UID=$P(LINE,U),X=$P(LINE,U,2),DELETE=($P(LINE,U,3)="DELETE"),TYPE=$S(X="KEY":"K",X="INTERP":"I",1:"") 78 I UID="" G PSINITZ 79 I INTERPFL,(TYPE'="K"),(TYPE'="U") S TYPE="I" ; just in case... 80 S IEN=$O(@IMGREF@(210,"B",UID,"")) 81 L +@IMGREF@(210,0):5 82 E Q 83 I 'IEN D ; Allocate node 84 . S X=$G(@IMGREF@(210,0)) I X="" S X="^2005.05A^^",^(0)=X 85 . S IEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=IEN,$P(X,U,4)=T 86 . S @IMGREF@(210,0)=X,@IMGREF@(210,"B",UID,IEN)="" 87 S PSIEN=IEN 88 I DELETE,PSIEN D ; delete this PS 89 . S PSKILCT=PSKILCT+1 90 . K @IMGREF@(210,PSIEN),@IMGREF@(210,"B",UID,PSIEN) 91 . S T=$O(@IMGREF@(210,9999),-1) 92 . I 'T K @IMGREF@(210) Q ; no more PSs! 93 . N XD S XD=$G(@IMGREF@(210,0)) 94 . S $P(XD,U,3)=T,T=$P(XD,U,4) S:T T=T-1 S $P(XD,U,4)=T 95 . S @IMGREF@(210,0)=XD 96 E D ; init PS node for storage; PSTRAK keeps data for later update to STUDY file 97 . S @IMGREF@(210,PSIEN,0)=UID_U_TYPE_U_DUZ_U_TIMESTMP 98 . I "KI"[TYPE S SEQNUM=SEQNUM+1,T=$G(PSTRAK(IMGIEN,TYPE,0))+1,PSTRAK(IMGIEN,TYPE,0)=T,PSTRAK(IMGIEN,TYPE,T)=UID_U_SEQNUM 99 . K @IMGREF@(210,PSIEN,1) ; init Data & Keys 100 . S @IMGREF@(210,PSIEN,1,0)="^2005.51^0_U_0" 101 L -@IMGREF@(210,0) 102 S SAVOP="SAVPS" ; indirect label reference for use in SAVE loop 103 I DELETE S SAVOP="NOOP" 104 S PSTOT=PSTOT+1-DELETE 105 PSINITZ Q 106 ; 107 SAVPS(LINE) ; Save a line of PS data 108 ; input = line of free-text data 109 N PSCT,PSCTRL 110 L +(@IMGREF@(210,PSIEN)) 111 S PSCTRL=$G(@IMGREF@(210,PSIEN,1,0)) 112 S PSCT=+$P(PSCTRL,U,4)+1 113 S @IMGREF@(210,PSIEN,1,PSCT,0)=LINE 114 S $P(PSCTRL,U,3,4)=PSCT_U_PSCT 115 S @IMGREF@(210,PSIEN,1,0)=PSCTRL 116 L -(@IMGREF@(210,PSIEN)) 117 S PSLINCT=PSLINCT+1 118 Q 119 ; 120 SAVKIMG(IMGIEN,UIDSEQ,TYPE,NEWIMG) ; store a Key image & Interp images w/ PS refs in study node 121 ; 122 N STIEN,KIEN,STUDYREF,UID,SEQNUM 123 I 'IMGIEN G SAVKIMGZ 124 S STIEN=$$STUDYID(IMGIEN,"",0) 125 I 'STIEN G SAVKIMGZ ; should never happen 126 S STUDYREF=$NA(^MAG(2005.001,STIEN)) 127 S UID=$P(UIDSEQ,U),SEQNUM=$P(UIDSEQ,U,2) 128 S KIEN=$O(@STUDYREF@(1,"B",IMGIEN,"")) 129 I 'KIEN D 130 . L +@STUDYREF@(1,0) 131 . S X=$G(@STUDYREF@(1,0)) I X="" S X="^2005.031P^^",^(0)=X 132 . S KIEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=KIEN,$P(X,U,4)=T 133 . S @STUDYREF@(1,0)=X,@STUDYREF@(1,"B",IMGIEN,KIEN)="" 134 . L -@STUDYREF@(1,0) 135 E D 136 . I 'NEWIMG Q 137 . K @STUDYREF@(1,KIEN,1) ; init ps data if updating existing img 138 . S @STUDYREF@(1,KIEN,1,0)="^2005.311^0_U_0" 139 S $P(@STUDYREF@(1,KIEN,0),U)=IMGIEN 140 ; store the PS UID 141 I UID]"" D 142 . N IEN S IEN=$O(@STUDYREF@(1,KIEN,1,"B",UID,"")) 143 . I 'IEN D 144 . . L +@STUDYREF@(1,KIEN,1,0) 145 . . S X=$G(@STUDYREF@(1,KIEN,1,0)) I X="" S X="^2005.311^^",^(0)=X 146 . . S IEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=IEN,$P(X,U,4)=T 147 . . S @STUDYREF@(1,KIEN,1,0)=X,@STUDYREF@(1,KIEN,1,"B",UID,IEN)="" 148 . . L -@STUDYREF@(1,KIEN,1,0) 149 . S @STUDYREF@(1,KIEN,1,IEN,0)=UID_U_TYPE_U_SEQNUM 150 S KEYCT=KEYCT+(TYPE="K"),INTCT=INTCT+(TYPE="I") 151 SAVKIMGZ Q 152 ; 153 STUDYID(IEN,RARPT,READONLY,INITSTDY) ; return Study_IEN for input ImgIEN or RARPT 154 ; initialize Study node if INITSTDY is indicated (optional) 155 ; Either IEN or RARPT must be supplied; if both supplied, only RARPT is used 156 ; if READONLY is false, then create "STUDY" node if undefined 157 ; <*> Note: this routine is hard-coded for RADIOLOGY image data only (Parent file=74) 158 N STIEN,X,T,STDYINIT 159 S STIEN="" ; init return value 160 S IEN=$G(IEN),RARPT=$G(RARPT) 161 S:'$D(READONLY) READONLY=1 162 S INITSTDY=$G(INITSTDY) 163 I IEN,'RARPT S RARPT=$$GETRPT(IEN) 164 I 'RARPT G STUDYIDZ 165 I $D(^MAG(2005.001,"ASTUDY",74,RARPT)) S STIEN=$O(^(RARPT,"")) D 166 . I INITSTDY="INIT_STUDY" K ^MAG(2005.001,STIEN,1) ; init for Key/Interp PS updates (full replacement) 167 E D:'READONLY ; create Study structure 168 . L +^MAG(2005.001,0) 169 . S X=^MAG(2005.001,0),STIEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=STIEN,$P(X,U,4)=T,^(0)=X 170 . L -^MAG(2005.001,0) 171 . S ^MAG(2005.001,STIEN,0)=RARPT_U_74,^MAG(2005.001,"ASTUDY",74,RARPT,STIEN)="",^MAG(2005.001,"B",RARPT,STIEN)="" 172 ; 173 STUDYIDZ Q:$Q STIEN Q 174 ; 175 GETRPT(IEN) ; return rarpt for input imgien 176 N IENGRP,X,RARPT 177 S RARPT="" 178 I IEN D 179 . I $D(^MAG(2005,IEN,1)) S IENGRP=IEN 180 . E S IENGRP=$P(^MAG(2005,IEN,0),U,10) 181 . I IENGRP S X=$G(^MAG(2005,IENGRP,2)) I $P(X,U,6)=74 S RARPT=$P(X,U,7) 182 . I RARPT,$D(^RARPT(RARPT,2005)) 183 . E S RARPT="" ; no Rad report node! 184 Q:$Q RARPT Q 185 ; 186 ;Structure of PS/PSTRAK data In: 187 ; *IMAGE 188 ; IEN^ 189 ; *PS 190 ; UID^[KEY/INTERP/USER] 191 ; 1: N Lines of PS data follow 192 ; *END_PS 193 ; *PS 194 ; UID^[KEY/INTERP/USER] 195 ; 1: N Lines of PS data follow 196 ; *END_PS 197 ; *END_IMAGE 198 ; *IMAGE 199 ; ... etc. 200 ; *END_IMAGE 201 ; *END 202 END ; 1 MAGJUPD2 ;WIRMFO/JHC VistaRad RPCs-Update PS & KEY Img ; 14 July 2004 10:05 AM 2 ;;3.0;IMAGING;**18**;Mar 07, 2006 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 ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR 20 D @^%ZOSF("ERRTN") 21 Q:$Q 1 Q 22 ; 23 SAVKPS(RARPT,INTERPFL,DATA,REPLY) ; Save study data: Key/Interpretation Images & Pres. State 24 ; RARPT--exam pointer 25 ; INTERPFL--1/0; 1=This is associated with a Rad Interpretation; Optional 26 ; DATA--array of input data; see structure at end of routine 27 ; REPLY--return string 28 N PSTRAK,IDATA,IMGCT,PSTOT,PSLINCT,PSKILCT,KEYCT,INTCT,STUDY,LINE,NEWIMG,NEWPS 29 N IMGREF,IMGIEN,PSIEN,SAVOP,STIEN,TYPE,IMG,ICT,NEWIMG,INITSTDY,SEQNUM 30 S INTERPFL=+$G(INTERPFL) 31 S NEWIMG=0,NEWPS=0,IMGIEN="",PSIEN="",SEQNUM=0 32 S (IMGCT,PSTOT,PSLINCT,KEYCT,INTCT,PSKILCT)=0 33 S IMGREF="",SAVOP="NOOP" 34 I '$D(TIMESTMP) N TIMESTMP D NOW^%DTC S TIMESTMP=% 35 ; 1st, process input in DATA 36 S IDATA="" 37 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S LINE=DATA(IDATA) I LINE]"" D 38 . I LINE="*IMAGE" S NEWIMG=1 Q 39 . I LINE="*PS" S NEWPS=1 Q 40 . I $E(LINE,1,4)="*END" S (NEWIMG,NEWPS)=0 Q 41 . I NEWIMG D IMGINIT(LINE) S NEWIMG=0 Q ; Init storage for this Image 42 . I NEWPS D PSINIT(LINE) S NEWPS=0 Q ; Init storage for a PS 43 . D @(SAVOP_"(LINE)") 44 ; Now update the Study node info 45 S INITSTDY=$S(INTERPFL:"INIT_STUDY",1:"") 46 S STIEN=$$STUDYID("",RARPT,1,INITSTDY) 47 I $D(PSTRAK) S IMG="" D ; Update key imgs in Study node 48 . F S IMG=$O(PSTRAK(IMG)) Q:'IMG S NEWIMG=1,TYPE="" D 49 . . F S TYPE=$O(PSTRAK(IMG,TYPE)) Q:TYPE="" D 50 . . . F ICT=1:1:PSTRAK(IMG,TYPE,0) D SAVKIMG(IMG,PSTRAK(IMG,TYPE,ICT),TYPE,NEWIMG) S NEWIMG=0 51 SAVKPSZ ; 52 I IMGCT!PSTOT!PSLINCT!KEYCT!INTCT S REPLY="1~Saved: "_KEYCT_" Key Image"_$S(KEYCT-1:"s",1:"")_"; "_INTCT_" Interp Image"_$S(INTCT-1:"s",1:"")_"; " 53 I S REPLY=REPLY_PSLINCT_" PS line"_$S(PSLINCT-1:"s",1:"")_" for "_PSTOT_" PS"_$S(PSTOT-1:"s",1:"")_" for "_IMGCT_" Image"_$S(IMGCT-1:"s.",1:".") 54 I S:PSKILCT REPLY=REPLY_" Deleted: "_PSKILCT_" PS record"_$S(PSKILCT-1:"s",1:"")_"." 55 E I PSKILCT S REPLY="1~Deleted: "_PSKILCT_" PS record"_$S(PSKILCT-1:"s",1:"")_"." 56 E S REPLY="0~No Key Image/PS data was stored or deleted." 57 Q 58 ; 59 NOOP(X) Q ; do nothing/ skip erroneous input 60 ; 61 IMGINIT(LINE) ; Init storage space for an image ; inits some vars for the SAVE loop 62 N IEN 63 S IMGIEN="",IMGREF="" 64 S IEN=$P(LINE,U) 65 I IEN,$D(^MAG(2005,IEN,0)),'$D(^(1)) 66 E G IMGINITZ 67 S IMGIEN=IEN 68 S IMGREF=$NA(^MAG(2005,IMGIEN)) ; indirect ref used in psinit & savps 69 S IMGCT=IMGCT+1 70 IMGINITZ Q 71 ; 72 PSINIT(LINE) ; Init storage space for a Presentation State ; inits some vars for SAVE loop 73 ; input = PS_UID ^ UID Type (KEY, INT) ^ "DELETE" 74 ; if peice 3 ="DELETE" then the PS data is deleted 75 N IEN,UID,TYPE,DELETE 76 S UID=$P(LINE,U),X=$P(LINE,U,2),DELETE=($P(LINE,U,3)="DELETE"),TYPE=$S(X="KEY":"K",X="INTERP":"I",1:"") 77 I UID="" G PSINITZ 78 I INTERPFL,(TYPE'="K"),(TYPE'="U") S TYPE="I" ; just in case... 79 S IEN=$O(@IMGREF@(210,"B",UID,"")) 80 L +@IMGREF@(210,0):5 81 E Q 82 I 'IEN D ; Allocate node 83 . S X=$G(@IMGREF@(210,0)) I X="" S X="^2005.05A^^",^(0)=X 84 . S IEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=IEN,$P(X,U,4)=T 85 . S @IMGREF@(210,0)=X,@IMGREF@(210,"B",UID,IEN)="" 86 S PSIEN=IEN 87 I DELETE,PSIEN D ; delete this PS 88 . S PSKILCT=PSKILCT+1 89 . K @IMGREF@(210,PSIEN),@IMGREF@(210,"B",UID,PSIEN) 90 . S T=$O(@IMGREF@(210,9999),-1) 91 . I 'T K @IMGREF@(210) Q ; no more PSs! 92 . N XD S XD=$G(@IMGREF@(210,0)) 93 . S $P(XD,U,3)=T,T=$P(XD,U,4) S:T T=T-1 S $P(XD,U,4)=T 94 . S @IMGREF@(210,0)=XD 95 E D ; init PS node for storage; PSTRAK keeps data for later update to STUDY file 96 . S @IMGREF@(210,PSIEN,0)=UID_U_TYPE_U_DUZ_U_TIMESTMP 97 . I "KI"[TYPE S SEQNUM=SEQNUM+1,T=$G(PSTRAK(IMGIEN,TYPE,0))+1,PSTRAK(IMGIEN,TYPE,0)=T,PSTRAK(IMGIEN,TYPE,T)=UID_U_SEQNUM 98 . K @IMGREF@(210,PSIEN,1) ; init Data & Keys 99 . S @IMGREF@(210,PSIEN,1,0)="^2005.51^0_U_0" 100 L -@IMGREF@(210,0) 101 S SAVOP="SAVPS" ; indirect label reference for use in SAVE loop 102 I DELETE S SAVOP="NOOP" 103 S PSTOT=PSTOT+1-DELETE 104 PSINITZ Q 105 ; 106 SAVPS(LINE) ; Save a line of PS data 107 ; input = line of free-text data 108 N PSCT,PSCTRL 109 L +(@IMGREF@(210,PSIEN)) 110 S PSCTRL=$G(@IMGREF@(210,PSIEN,1,0)) 111 S PSCT=+$P(PSCTRL,U,4)+1 112 S @IMGREF@(210,PSIEN,1,PSCT,0)=LINE 113 S $P(PSCTRL,U,3,4)=PSCT_U_PSCT 114 S @IMGREF@(210,PSIEN,1,0)=PSCTRL 115 L -(@IMGREF@(210,PSIEN)) 116 S PSLINCT=PSLINCT+1 117 Q 118 ; 119 SAVKIMG(IMGIEN,UIDSEQ,TYPE,NEWIMG) ; store a Key image & Interp images w/ PS refs in study node 120 ; 121 N STIEN,KIEN,STUDYREF,UID,SEQNUM 122 I 'IMGIEN G SAVKIMGZ 123 S STIEN=$$STUDYID(IMGIEN,"",0) 124 I 'STIEN G SAVKIMGZ ; should never happen 125 S STUDYREF=$NA(^MAG(2005.001,STIEN)) 126 S UID=$P(UIDSEQ,U),SEQNUM=$P(UIDSEQ,U,2) 127 S KIEN=$O(@STUDYREF@(1,"B",IMGIEN,"")) 128 I 'KIEN D 129 . L +@STUDYREF@(1,0) 130 . S X=$G(@STUDYREF@(1,0)) I X="" S X="^2005.031P^^",^(0)=X 131 . S KIEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=KIEN,$P(X,U,4)=T 132 . S @STUDYREF@(1,0)=X,@STUDYREF@(1,"B",IMGIEN,KIEN)="" 133 . L -@STUDYREF@(1,0) 134 E D 135 . I 'NEWIMG Q 136 . K @STUDYREF@(1,KIEN,1) ; init ps data if updating existing img 137 . S @STUDYREF@(1,KIEN,1,0)="^2005.311^0_U_0" 138 S $P(@STUDYREF@(1,KIEN,0),U)=IMGIEN 139 ; store the PS UID 140 I UID]"" D 141 . N IEN S IEN=$O(@STUDYREF@(1,KIEN,1,"B",UID,"")) 142 . I 'IEN D 143 . . L +@STUDYREF@(1,KIEN,1,0) 144 . . S X=$G(@STUDYREF@(1,KIEN,1,0)) I X="" S X="^2005.311^^",^(0)=X 145 . . S IEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=IEN,$P(X,U,4)=T 146 . . S @STUDYREF@(1,KIEN,1,0)=X,@STUDYREF@(1,KIEN,1,"B",UID,IEN)="" 147 . . L -@STUDYREF@(1,KIEN,1,0) 148 . S @STUDYREF@(1,KIEN,1,IEN,0)=UID_U_TYPE_U_SEQNUM 149 S KEYCT=KEYCT+(TYPE="K"),INTCT=INTCT+(TYPE="I") 150 SAVKIMGZ Q 151 ; 152 STUDYID(IEN,RARPT,READONLY,INITSTDY) ; return Study_IEN for input ImgIEN or RARPT 153 ; initialize Study node if INITSTDY is indicated (optional) 154 ; Either IEN or RARPT must be supplied; if both supplied, only RARPT is used 155 ; if READONLY is false, then create "STUDY" node if undefined 156 ; <*> Note: this routine is hard-coded for RADIOLOGY image data only (Parent file=74) 157 N STIEN,X,T,STDYINIT 158 S STIEN="" ; init return value 159 S IEN=$G(IEN),RARPT=$G(RARPT) 160 S:'$D(READONLY) READONLY=1 161 S INITSTDY=$G(INITSTDY) 162 I IEN,'RARPT S RARPT=$$GETRPT(IEN) 163 I 'RARPT G STUDYIDZ 164 I $D(^MAG(2005.001,"ASTUDY",74,RARPT)) S STIEN=$O(^(RARPT,"")) D 165 . I INITSTDY="INIT_STUDY" K ^MAG(2005.001,STIEN,1) ; init for Key/Interp PS updates (full replacement) 166 E D:'READONLY ; create Study structure 167 . L +^MAG(2005.001,0) 168 . S X=^MAG(2005.001,0),STIEN=$P(X,U,3)+1,T=$P(X,U,4)+1,$P(X,U,3)=STIEN,$P(X,U,4)=T,^(0)=X 169 . L -^MAG(2005.001,0) 170 . S ^MAG(2005.001,STIEN,0)=RARPT_U_74,^MAG(2005.001,"ASTUDY",74,RARPT,STIEN)="",^MAG(2005.001,"B",RARPT,STIEN)="" 171 ; 172 STUDYIDZ Q:$Q STIEN Q 173 ; 174 GETRPT(IEN) ; return rarpt for input imgien 175 N IENGRP,X,RARPT 176 S RARPT="" 177 I IEN D 178 . I $D(^MAG(2005,IEN,1)) S IENGRP=IEN 179 . E S IENGRP=$P(^MAG(2005,IEN,0),U,10) 180 . I IENGRP S X=$G(^MAG(2005,IENGRP,2)) I $P(X,U,6)=74 S RARPT=$P(X,U,7) 181 . I RARPT,$D(^RARPT(RARPT,2005)) 182 . E S RARPT="" ; no Rad report node! 183 Q:$Q RARPT Q 184 ; 185 ;Structure of PS/PSTRAK data In: 186 ; *IMAGE 187 ; IEN^ 188 ; *PS 189 ; UID^[KEY/INTERP/USER] 190 ; 1: N Lines of PS data follow 191 ; *END_PS 192 ; *PS 193 ; UID^[KEY/INTERP/USER] 194 ; 1: N Lines of PS data follow 195 ; *END_PS 196 ; *END_IMAGE 197 ; *IMAGE 198 ; ... etc. 199 ; *END_IMAGE 200 ; *END 201 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
