MAGDOD01 ;WOIFO/EdM - VistA DOD Exchange Utilities ; 29 Apr 2008 10:56 AM
;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
;; 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
;
STOREUID(OUT,IMAGE,SERIES,SNUM,INUM,IMGUID,STUID,DOCDAT) ; RPC = MAG STORE TEXT FILE DETAILS
N D0,D1,FM,I,IMG,LI,LS,X,XI,XS
I '$$KEY() S OUT="-13,No permission to call this Remote Procedure" Q
S FM=""
I '$G(IMAGE) S OUT="-5,No valid image number specified." Q
D CHK^MAGGSQI(.X,IMAGE) I +$G(X(0))'=1 D Q
. S OUT=IMAGE_"-14,Questionable Integrity"
. Q
K X
S:$G(^MAG(2005,IMAGE,0))'="" FM=2005
S:$G(^MAG(2005.1,IMAGE,0))'="" FM=2005.1
I FM="" S OUT="-1,No such image """_IMAGE_"""." Q
S OUT=-13,(D0,D1)=0,(IMG,LS,LI,XS,XI)=""
D:$TR($G(SNUM)_$G(INUM),0)'=""
. S D0=+$P(^MAG(FM,IMAGE,0),"^",10) Q:'D0
. S I=0 F S I=$O(^MAG(FM,D0,1,I)) Q:'I D Q:D1
. . S X=$G(^MAG(FM,D0,1,I,0)) Q:+X'=IMAGE
. . S D1=I,IMG=$P(X,"^",1),(LS,XS)=$P(X,"^",2),(LI,XI)=$P(X,"^",3)
. . Q
. S:'D0 OUT=OUT_", image is not part of series ("_SNUM_"/"_INUM_")"
. S:'D1 OUT=OUT_", image is not in series "_D0_" ("_SNUM_"/"_INUM_")"
. Q
D:$G(SERIES)'=""
. S X=$G(^MAG(FM,IMAGE,"SERIESUID")) Q:X=SERIES
. I X'="" S OUT=OUT_", cannot enter Series Instance UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New: "_SERIES Q
. S ^MAG(FM,IMAGE,"SERIESUID")=SERIES
. S ^MAG(FM,"SERIESUID",SERIES,IMAGE)=""
. Q
D:$G(SNUM)'=""
. Q:LS=SNUM
. I LS'="" S OUT=OUT_", cannot enter Series Number """_LS_"""'="""_SNUM_"""." Q
. S $P(^MAG(FM,D0,1,D1,0),"^",2)=SNUM
. I IMG'="",LS'="",LI'="" K ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
. S XS=SNUM
. Q
D:$G(INUM)'=""
. Q:LI=INUM
. I LI'="" S OUT=OUT_", cannot enter Instance Number"""_LI_"""'="""_INUM_"""." Q
. S $P(^MAG(FM,D0,1,D1,0),"^",3)=INUM
. I IMG'="",LS'="",LI'="" K ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
. S XI=INUM
. Q
I IMG'="",XS'="",XI'="" S ^MAG(FM,D0,1,"ADCM",XS,XI,IMG,D1)=""
D:$G(IMGUID)'=""
. S X=$P($G(^MAG(FM,IMAGE,"PACS")),"^",1)
. Q:X=IMGUID
. I X'="",X'=IMGUID S OUT=OUT_", cannot enter Instance UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New: "_IMGUID Q
. S $P(^MAG(FM,IMAGE,"PACS"),"^",1)=IMGUID
. S ^MAG(FM,"P",IMGUID,IMAGE)=""
. Q
D:$G(STUID)'=""
. N PARENT
. S PARENT=$P($G(^MAG(FM,IMAGE,0)),"^",10)
. I 'PARENT S OUT=OUT_", cannot find parent for image "_IMAGE Q
. S X=$P($G(^MAG(FM,PARENT,"PACS")),"^",1)
. Q:X=STUID
. I X'="",X'=STUID S OUT=OUT_", cannot enter Study UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New: "_STUID Q
. S $P(^MAG(FM,PARENT,"PACS"),"^",1)=STUID
. S ^MAG(FM,"P",STUID,PARENT)=""
. Q
D:$G(DOCDAT)'="" ;//110 CREATION DATE
. N PARENT,CHILD
. S PARENT=+$P($G(^MAG(FM,IMAGE,0)),"^",10) D:PARENT
. . I $P($G(^MAG(FM,PARENT,100)),"^",6)="" D
. . . S CHILD=$O(^MAG(FM,PARENT,1,0)) Q:'CHILD
. . . S X=$G(^MAG(FM,PARENT,1,CHILD,0)) Q:+X'=IMAGE
. . . S $P(^MAG(FM,PARENT,100),"^",6)=DOCDAT ;set parent
. . . Q
. . Q
. S X=$P($G(^MAG(FM,IMAGE,100)),"^",6)
. Q:X=DOCDAT
. I X'="",X'=DOCDAT S OUT=OUT_", cannot enter Document Date"_$C(13,10)_"Current: "_X_$C(13,10)_"New: "_DOCDAT Q
. S $P(^MAG(FM,IMAGE,100),"^",6)=DOCDAT ;set child
. Q
S:OUT=-13 OUT="0,OK"
Q
;
SCANIMG(OUT,ACTION,IMAGE,DIR) ; RPC = MAG SCAN IMAGE TEXT FILES
N F1,F2,F3,X
I '$$KEY() S OUT="-13,No permission to call this Remote Procedure" Q
S ACTION=$G(ACTION)
I ACTION="Init" D Q
. S X=$G(^MAGDICOM(2006.563,1,"SCAN")) S:X="" X=" ^-1"
. S OUT=X
. Q
I ACTION="Restart" D Q
. S (^MAGDICOM(2006.563,1,"SCAN"),OUT)=" ^-1"
. Q
I ACTION="Scan" D Q
. S DIR=$S($G(DIR)<0:-1,1:1)
. S IMAGE=+$G(IMAGE) I 'IMAGE,DIR<0 S IMAGE=" "
. S ^MAGDICOM(2006.563,1,"SCAN")=IMAGE_"^"_DIR
. S IMAGE=$O(^MAG(2005,IMAGE),DIR)
. I 'IMAGE S OUT="-1,Done" Q
. D FILEFIND^MAGDFB(IMAGE,"TEXT",0,0,.F1,.F2,.F3)
. S OUT=IMAGE_","_F2_","_$$NEARFMT^MAGUF(IMAGE)
. Q
S OUT="-13,Cannot perform requested action: """_ACTION_"""."
Q
;
FINDFIL(OUT,IMAGE) ; RPC = MAG FIND IMAGE TEXT FILE
N F1,F2,F3,IEN
N FM ; ------- file on which the image record exists (2005 or 2005.1)
N IM0 ; ------ zero node of this image record (not parent)
N CANUPD ; --- flag indicating that there are fields to be updated on the record
N PDLIM ; ---- primary delimiter
S PDLIM="|"
I '$$KEY() S $P(OUT,PDLIM,2)="-12,No permission to call this Remote Procedure" Q
I IMAGE="" S $P(OUT,PDLIM,2)="-21,Image file name must be specified" Q
I IMAGE?.E1C.E S $P(OUT,PDLIM,2)="-22,Invalid filename format (no control characters allowed)" Q
S FM=2005,IEN=$O(^MAG(FM,"F",IMAGE,"")) ; scan active image records
I 'IEN S FM=2005.1,IEN=$O(^MAG(FM,"F",IMAGE,""))
I 'IEN S $P(OUT,PDLIM,2)="-23,Image filename not found on VistA" Q
D FILEFIND^MAGDFB(IEN,"TEXT",0,0,.F1,.F2,.F3)
S OUT=IEN_PDLIM_F2_PDLIM_$$NEARFMT^MAGUF(IEN)
S IM0=$G(^MAG(FM,IEN,0))
; check for dupes and integrity problems
S:$P(IM0,"^",12) $P(OUT,PDLIM,4)="D" ; dupe
S:$P(IM0,"^",11) $P(OUT,PDLIM,5)="IQ" ; integrity
; can this record be updated?
S CANUPD=0 ; assume all updatable fields are populated, so not
D ; check to see if there are any updatable fields
. N PARENT ; --- parent record of the study of which this image is a member
. D Q:CANUPD ; check Series Instance UID
. . I $P($G(^MAG(FM,IEN,"SERIESUID")),"^",1)="" S CANUPD=1
. . Q
. D Q:CANUPD ; check Image Instance UID
. . I $P($G(^MAG(FM,IEN,"PACS")),"^",1)="" S CANUPD=1
. . Q
. S PARENT=$P($G(^MAG(FM,IEN,0)),"^",10)
. D:PARENT ; check attributes of parent study
. . D Q:CANUPD ; check Study Instance UID
. . . I $P($G(^MAG(FM,PARENT,"PACS")),"^",1)="" S CANUPD=1
. . . Q
. . D Q:CANUPD ; check Document Date
. . . I $P($G(^MAG(FM,PARENT,100)),"^",6)="" S CANUPD=1
. . . Q
. . D Q:CANUPD ; check DICOM series and image number
. . . N CHILD ; ---- what child this image is of the parent
. . . N I ; -------- scratch loop index
. . . S CHILD=0
. . . F S CHILD=$O(^MAG(FM,PARENT,1,CHILD)) Q:'CHILD I $P($G(^(CHILD,0)),"^",1)=IEN Q
. . . Q:'CHILD ; image not found in study
. . . F I=2,3 I $P($G(^MAG(FM,PARENT,1,CHILD,0)),"^",I)="" S CANUPD=1 Q
. . . Q
. . Q
. Q
S $P(OUT,PDLIM,6)=CANUPD
Q
KEY() N KEY,PRIV
S KEY(1)="MAG DOD FIX"
D OWNSKEY^XUSRB(.PRIV,.KEY)
Q PRIV(1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDOD01 7283 printed Sep 23, 2025@19:36:58 Page 2
MAGDOD01 ;WOIFO/EdM - VistA DOD Exchange Utilities ; 29 Apr 2008 10:56 AM
+1 ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
STOREUID(OUT,IMAGE,SERIES,SNUM,INUM,IMGUID,STUID,DOCDAT) ; RPC = MAG STORE TEXT FILE DETAILS
+1 NEW D0,D1,FM,I,IMG,LI,LS,X,XI,XS
+2 IF '$$KEY()
SET OUT="-13,No permission to call this Remote Procedure"
QUIT
+3 SET FM=""
+4 IF '$GET(IMAGE)
SET OUT="-5,No valid image number specified."
QUIT
+5 DO CHK^MAGGSQI(.X,IMAGE)
IF +$GET(X(0))'=1
Begin DoDot:1
+6 SET OUT=IMAGE_"-14,Questionable Integrity"
+7 QUIT
End DoDot:1
QUIT
+8 KILL X
+9 if $GET(^MAG(2005,IMAGE,0))'=""
SET FM=2005
+10 if $GET(^MAG(2005.1,IMAGE,0))'=""
SET FM=2005.1
+11 IF FM=""
SET OUT="-1,No such image """_IMAGE_"""."
QUIT
+12 SET OUT=-13
SET (D0,D1)=0
SET (IMG,LS,LI,XS,XI)=""
+13 if $TRANSLATE($GET(SNUM)_$GET(INUM),0)'=""
Begin DoDot:1
+14 SET D0=+$PIECE(^MAG(FM,IMAGE,0),"^",10)
if 'D0
QUIT
+15 SET I=0
FOR
SET I=$ORDER(^MAG(FM,D0,1,I))
if 'I
QUIT
Begin DoDot:2
+16 SET X=$GET(^MAG(FM,D0,1,I,0))
if +X'=IMAGE
QUIT
+17 SET D1=I
SET IMG=$PIECE(X,"^",1)
SET (LS,XS)=$PIECE(X,"^",2)
SET (LI,XI)=$PIECE(X,"^",3)
+18 QUIT
End DoDot:2
if D1
QUIT
+19 if 'D0
SET OUT=OUT_", image is not part of series ("_SNUM_"/"_INUM_")"
+20 if 'D1
SET OUT=OUT_", image is not in series "_D0_" ("_SNUM_"/"_INUM_")"
+21 QUIT
End DoDot:1
+22 if $GET(SERIES)'=""
Begin DoDot:1
+23 SET X=$GET(^MAG(FM,IMAGE,"SERIESUID"))
if X=SERIES
QUIT
+24 IF X'=""
SET OUT=OUT_", cannot enter Series Instance UID"_$CHAR(13,10)_"Current: "_X_$CHAR(13,10)_"New: "_SERIES
QUIT
+25 SET ^MAG(FM,IMAGE,"SERIESUID")=SERIES
+26 SET ^MAG(FM,"SERIESUID",SERIES,IMAGE)=""
+27 QUIT
End DoDot:1
+28 if $GET(SNUM)'=""
Begin DoDot:1
+29 if LS=SNUM
QUIT
+30 IF LS'=""
SET OUT=OUT_", cannot enter Series Number """_LS_"""'="""_SNUM_"""."
QUIT
+31 SET $PIECE(^MAG(FM,D0,1,D1,0),"^",2)=SNUM
+32 IF IMG'=""
IF LS'=""
IF LI'=""
KILL ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
+33 SET XS=SNUM
+34 QUIT
End DoDot:1
+35 if $GET(INUM)'=""
Begin DoDot:1
+36 if LI=INUM
QUIT
+37 IF LI'=""
SET OUT=OUT_", cannot enter Instance Number"""_LI_"""'="""_INUM_"""."
QUIT
+38 SET $PIECE(^MAG(FM,D0,1,D1,0),"^",3)=INUM
+39 IF IMG'=""
IF LS'=""
IF LI'=""
KILL ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
+40 SET XI=INUM
+41 QUIT
End DoDot:1
+42 IF IMG'=""
IF XS'=""
IF XI'=""
SET ^MAG(FM,D0,1,"ADCM",XS,XI,IMG,D1)=""
+43 if $GET(IMGUID)'=""
Begin DoDot:1
+44 SET X=$PIECE($GET(^MAG(FM,IMAGE,"PACS")),"^",1)
+45 if X=IMGUID
QUIT
+46 IF X'=""
IF X'=IMGUID
SET OUT=OUT_", cannot enter Instance UID"_$CHAR(13,10)_"Current: "_X_$CHAR(13,10)_"New: "_IMGUID
QUIT
+47 SET $PIECE(^MAG(FM,IMAGE,"PACS"),"^",1)=IMGUID
+48 SET ^MAG(FM,"P",IMGUID,IMAGE)=""
+49 QUIT
End DoDot:1
+50 if $GET(STUID)'=""
Begin DoDot:1
+51 NEW PARENT
+52 SET PARENT=$PIECE($GET(^MAG(FM,IMAGE,0)),"^",10)
+53 IF 'PARENT
SET OUT=OUT_", cannot find parent for image "_IMAGE
QUIT
+54 SET X=$PIECE($GET(^MAG(FM,PARENT,"PACS")),"^",1)
+55 if X=STUID
QUIT
+56 IF X'=""
IF X'=STUID
SET OUT=OUT_", cannot enter Study UID"_$CHAR(13,10)_"Current: "_X_$CHAR(13,10)_"New: "_STUID
QUIT
+57 SET $PIECE(^MAG(FM,PARENT,"PACS"),"^",1)=STUID
+58 SET ^MAG(FM,"P",STUID,PARENT)=""
+59 QUIT
End DoDot:1
+60 ;//110 CREATION DATE
if $GET(DOCDAT)'=""
Begin DoDot:1
+61 NEW PARENT,CHILD
+62 SET PARENT=+$PIECE($GET(^MAG(FM,IMAGE,0)),"^",10)
if PARENT
Begin DoDot:2
+63 IF $PIECE($GET(^MAG(FM,PARENT,100)),"^",6)=""
Begin DoDot:3
+64 SET CHILD=$ORDER(^MAG(FM,PARENT,1,0))
if 'CHILD
QUIT
+65 SET X=$GET(^MAG(FM,PARENT,1,CHILD,0))
if +X'=IMAGE
QUIT
+66 ;set parent
SET $PIECE(^MAG(FM,PARENT,100),"^",6)=DOCDAT
+67 QUIT
End DoDot:3
+68 QUIT
End DoDot:2
+69 SET X=$PIECE($GET(^MAG(FM,IMAGE,100)),"^",6)
+70 if X=DOCDAT
QUIT
+71 IF X'=""
IF X'=DOCDAT
SET OUT=OUT_", cannot enter Document Date"_$CHAR(13,10)_"Current: "_X_$CHAR(13,10)_"New: "_DOCDAT
QUIT
+72 ;set child
SET $PIECE(^MAG(FM,IMAGE,100),"^",6)=DOCDAT
+73 QUIT
End DoDot:1
+74 if OUT=-13
SET OUT="0,OK"
+75 QUIT
+76 ;
SCANIMG(OUT,ACTION,IMAGE,DIR) ; RPC = MAG SCAN IMAGE TEXT FILES
+1 NEW F1,F2,F3,X
+2 IF '$$KEY()
SET OUT="-13,No permission to call this Remote Procedure"
QUIT
+3 SET ACTION=$GET(ACTION)
+4 IF ACTION="Init"
Begin DoDot:1
+5 SET X=$GET(^MAGDICOM(2006.563,1,"SCAN"))
if X=""
SET X=" ^-1"
+6 SET OUT=X
+7 QUIT
End DoDot:1
QUIT
+8 IF ACTION="Restart"
Begin DoDot:1
+9 SET (^MAGDICOM(2006.563,1,"SCAN"),OUT)=" ^-1"
+10 QUIT
End DoDot:1
QUIT
+11 IF ACTION="Scan"
Begin DoDot:1
+12 SET DIR=$SELECT($GET(DIR)<0:-1,1:1)
+13 SET IMAGE=+$GET(IMAGE)
IF 'IMAGE
IF DIR<0
SET IMAGE=" "
+14 SET ^MAGDICOM(2006.563,1,"SCAN")=IMAGE_"^"_DIR
+15 SET IMAGE=$ORDER(^MAG(2005,IMAGE),DIR)
+16 IF 'IMAGE
SET OUT="-1,Done"
QUIT
+17 DO FILEFIND^MAGDFB(IMAGE,"TEXT",0,0,.F1,.F2,.F3)
+18 SET OUT=IMAGE_","_F2_","_$$NEARFMT^MAGUF(IMAGE)
+19 QUIT
End DoDot:1
QUIT
+20 SET OUT="-13,Cannot perform requested action: """_ACTION_"""."
+21 QUIT
+22 ;
FINDFIL(OUT,IMAGE) ; RPC = MAG FIND IMAGE TEXT FILE
+1 NEW F1,F2,F3,IEN
+2 ; ------- file on which the image record exists (2005 or 2005.1)
NEW FM
+3 ; ------ zero node of this image record (not parent)
NEW IM0
+4 ; --- flag indicating that there are fields to be updated on the record
NEW CANUPD
+5 ; ---- primary delimiter
NEW PDLIM
+6 SET PDLIM="|"
+7 IF '$$KEY()
SET $PIECE(OUT,PDLIM,2)="-12,No permission to call this Remote Procedure"
QUIT
+8 IF IMAGE=""
SET $PIECE(OUT,PDLIM,2)="-21,Image file name must be specified"
QUIT
+9 IF IMAGE?.E1C.E
SET $PIECE(OUT,PDLIM,2)="-22,Invalid filename format (no control characters allowed)"
QUIT
+10 ; scan active image records
SET FM=2005
SET IEN=$ORDER(^MAG(FM,"F",IMAGE,""))
+11 IF 'IEN
SET FM=2005.1
SET IEN=$ORDER(^MAG(FM,"F",IMAGE,""))
+12 IF 'IEN
SET $PIECE(OUT,PDLIM,2)="-23,Image filename not found on VistA"
QUIT
+13 DO FILEFIND^MAGDFB(IEN,"TEXT",0,0,.F1,.F2,.F3)
+14 SET OUT=IEN_PDLIM_F2_PDLIM_$$NEARFMT^MAGUF(IEN)
+15 SET IM0=$GET(^MAG(FM,IEN,0))
+16 ; check for dupes and integrity problems
+17 ; dupe
if $PIECE(IM0,"^",12)
SET $PIECE(OUT,PDLIM,4)="D"
+18 ; integrity
if $PIECE(IM0,"^",11)
SET $PIECE(OUT,PDLIM,5)="IQ"
+19 ; can this record be updated?
+20 ; assume all updatable fields are populated, so not
SET CANUPD=0
+21 ; check to see if there are any updatable fields
Begin DoDot:1
+22 ; --- parent record of the study of which this image is a member
NEW PARENT
+23 ; check Series Instance UID
Begin DoDot:2
+24 IF $PIECE($GET(^MAG(FM,IEN,"SERIESUID")),"^",1)=""
SET CANUPD=1
+25 QUIT
End DoDot:2
if CANUPD
QUIT
+26 ; check Image Instance UID
Begin DoDot:2
+27 IF $PIECE($GET(^MAG(FM,IEN,"PACS")),"^",1)=""
SET CANUPD=1
+28 QUIT
End DoDot:2
if CANUPD
QUIT
+29 SET PARENT=$PIECE($GET(^MAG(FM,IEN,0)),"^",10)
+30 ; check attributes of parent study
if PARENT
Begin DoDot:2
+31 ; check Study Instance UID
Begin DoDot:3
+32 IF $PIECE($GET(^MAG(FM,PARENT,"PACS")),"^",1)=""
SET CANUPD=1
+33 QUIT
End DoDot:3
if CANUPD
QUIT
+34 ; check Document Date
Begin DoDot:3
+35 IF $PIECE($GET(^MAG(FM,PARENT,100)),"^",6)=""
SET CANUPD=1
+36 QUIT
End DoDot:3
if CANUPD
QUIT
+37 ; check DICOM series and image number
Begin DoDot:3
+38 ; ---- what child this image is of the parent
NEW CHILD
+39 ; -------- scratch loop index
NEW I
+40 SET CHILD=0
+41 FOR
SET CHILD=$ORDER(^MAG(FM,PARENT,1,CHILD))
if 'CHILD
QUIT
IF $PIECE($GET(^(CHILD,0)),"^",1)=IEN
QUIT
+42 ; image not found in study
if 'CHILD
QUIT
+43 FOR I=2,3
IF $PIECE($GET(^MAG(FM,PARENT,1,CHILD,0)),"^",I)=""
SET CANUPD=1
QUIT
+44 QUIT
End DoDot:3
if CANUPD
QUIT
+45 QUIT
End DoDot:2
+46 QUIT
End DoDot:1
+47 SET $PIECE(OUT,PDLIM,6)=CANUPD
+48 QUIT
KEY() NEW KEY,PRIV
+1 SET KEY(1)="MAG DOD FIX"
+2 DO OWNSKEY^XUSRB(.PRIV,.KEY)
+3 QUIT PRIV(1)
+4 ;
