- MAGGSIA ;WOIFO/GEK/SG/NST - Imaging RPC Broker calls. Add/Modify Image entry ; Dec 05, 2018@10:43am
- ;;3.0;IMAGING;**7,21,8,59,93,201,221**;Dec 02, 2009;Build 163
- ;;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
- ;
- ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE
- ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL.
- ;
- ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE]
- ; Calls UPDATE^DIE to Add an Image File entry
- ; Called from Import API Delphi component and ImportX (Active X) control.
- ; Parameters :
- ; MAGARRAY - array of field numbers and their entries
- ; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38
- ; If Long Description is included in array (field 11), we create a new
- ; array to hold the text, and pass that to UPDATE^DIE
- ; If this entry is an Image Group
- ; i.e. MAGARRAY(n)="2005.04^344"
- ; (the field 2005.04 is the OBJECT GROUP MULTIPLE)
- ; ( 344 is the pointer to the Image File Entry that will be added
- ; ( as a member of this new/existing Group)
- ;
- ; Return Variable
- ;
- ; MAGRY(0) - Array
- ; Successful MAGRY(0) = IEN^FILE NAME (with full path)
- ; UNsuccessful MAGRY(0) = 0^Error desc
- ; MAGRY(0)(1..n) = Errors and warnings.
- ;
- ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK
- ; TO THE NEW FILE NAME RETURNED BY THIS CALL.
- ; Changed to include hierarchical directory hash - PMK 04/23/98
- ;----------------------------------------------------------------
- N MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM
- N MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE
- N NEWIEN,I,J,X,Y,Z,WPCT
- ;
- N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGSERR"
- I ($D(MAGARRAY)<10) S MAGRY(0)="0^No input data, Operation CANCELED" Q
- ;
- S MAGRY(0)="0^Creating VistA Image Entry..."
- S MAGERR="",MAGGRP=0,GRPCT=1,WPCT=0
- ; Validate the Data, and Action codes in the Input Array
- D VAL^MAGGSIV(.MAGRY,.MAGARRAY) I 'MAGRY(0) Q
- ;
- ; Make the FileMan FDA array and the Imaging Action array.
- D MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP)
- I '$D(MAGGFDA(2005,"+1,")) S MAGRY(0)="0^No data to file. Operation CANCELED." Q
- ;
- ;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43)))
- ; Check on some possible problems: required fields, create default values etc.
- D PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF) I $L(MAGERR) S MAGRY(0)=MAGERR Q
- ; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two.
- S (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12() ; SG - MAG*3*93
- D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- ;
- ; ERROR: QUIT
- I '$G(MAGGIEN(1)) D S MAGRY(0)=MAGERR Q
- . S MAGERR="0^ERROR Creating new Image File Entry "
- . I $D(DIERR) D RTRNERR^MAGGSIU1(.MAGERR)
- . D CLEAN
- ;
- S MAGGDA=MAGGIEN(1)
- ;
- D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
- ;
- ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT
- ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename
- I MAGGRP D G C1
- . D UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA)
- . S MAGRY(0)=MAGGDA_U
- . D CLEAN
- . Q
- ; ENTRY in Image File has been made, if any errors from here on
- ; then we have to delete the image entry.
- ; IF This image is a member of a Group, Update the Group Entry with new child.
- S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q
- . D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA)
- . I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN
- ;
- ; Now generate the Image FileName. This is passed back to the calling app,
- ; and the calling app is responsible for renaming/copying the Image File to
- ; this new name.
- I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1)
- E D I $L(MAGERR) S MAGRY(0)=MAGERR Q
- . N MAGXFDA
- . S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGACT("EXT"))) I 'X D Q
- . . S MAGERR=X
- . . D KILLENT^MAGGSIU1(MAGGDA)
- . . D CLEAN
- . ;
- . S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
- . S MAGXFDA(2005,Y,1)=MAGGFNM
- . D UPDATE^DIE("","MAGXFDA","","MAGGXE")
- . ; in case of an error
- . I $D(DIERR) D Q
- . . D RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE)
- . . D KILLENT^MAGGSIU1(MAGGDA)
- . . D CLEAN
- ;
- C1 ; 59
- K MAGGFDA ; P59.
- ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry
- I '$D(^MAG(2005,MAGGDA,40)) D
- . N INDXD
- . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
- . D COMIEN^MAGXCVC(MAGGDA,.INDXD)
- . S ^MAGIXCVT(2006.96,MAGGDA)=1 ; Flag. Says fields were converted by index generation
- . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
- . ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108))
- . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5))
- . Q
- ;
- ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
- I '$P(^MAG(2005,MAGGDA,40),"^",3) D
- . N INDXD,OLD40,N40
- . S (N40,OLD40)=^MAG(2005,MAGGDA,40)
- . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
- . ; If Origin doesn't exist in existing, this will put V in.
- . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
- . ; We're not changing existing values of Spec,Proc or Origin
- . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
- . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
- . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5)
- . S ^MAG(2005,MAGGDA,40)=N40
- . ;;D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
- . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5))
- . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
- . Q
- ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
- ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation
- ;
- ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG]
- ; example: 487^C:\IMAGE\^DC000487.TIF
- ; The calling routine is responsible for renaming/naming the file
- ; to the returned DRIVE:\DIR\FILENAME.EXT
- ;
- ; Modified 4/23/98 to include hierarchical directory structure -- PMK
- I 'MAGGRP D
- . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
- . ; For now, BIG files are in same directory as FullRes (or PACS) file
- . S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
- . ; If BIG file also, add it's Drive, Hash, Filename to end of Return string.
- . I $G(MAGACT("BIG")) D
- . . S X=$P(MAGGFNM,".",1)_".BIG"
- . . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X
- . . Q
- . Q
- ;
- N MAGOUT
- D NWI2005^MAGNWRK1(.MAGOUT,MAGGDA) ; add a new storage work item
- ;
- CLEAN ; Called as tag
- D CLEAN^DILF
- L -^MAG(2005,NEWIEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIA 7893 printed Jan 18, 2025@03:03:54 Page 2
- MAGGSIA ;WOIFO/GEK/SG/NST - Imaging RPC Broker calls. Add/Modify Image entry ; Dec 05, 2018@10:43am
- +1 ;;3.0;IMAGING;**7,21,8,59,93,201,221**;Dec 02, 2009;Build 163
- +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 ;; | |
- +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 QUIT
- +19 ;
- +20 ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE
- +21 ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL.
- +22 ;
- ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE]
- +1 ; Calls UPDATE^DIE to Add an Image File entry
- +2 ; Called from Import API Delphi component and ImportX (Active X) control.
- +3 ; Parameters :
- +4 ; MAGARRAY - array of field numbers and their entries
- +5 ; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38
- +6 ; If Long Description is included in array (field 11), we create a new
- +7 ; array to hold the text, and pass that to UPDATE^DIE
- +8 ; If this entry is an Image Group
- +9 ; i.e. MAGARRAY(n)="2005.04^344"
- +10 ; (the field 2005.04 is the OBJECT GROUP MULTIPLE)
- +11 ; ( 344 is the pointer to the Image File Entry that will be added
- +12 ; ( as a member of this new/existing Group)
- +13 ;
- +14 ; Return Variable
- +15 ;
- +16 ; MAGRY(0) - Array
- +17 ; Successful MAGRY(0) = IEN^FILE NAME (with full path)
- +18 ; UNsuccessful MAGRY(0) = 0^Error desc
- +19 ; MAGRY(0)(1..n) = Errors and warnings.
- +20 ;
- +21 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK
- +22 ; TO THE NEW FILE NAME RETURNED BY THIS CALL.
- +23 ; Changed to include hierarchical directory hash - PMK 04/23/98
- +24 ;----------------------------------------------------------------
- +25 NEW MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM
- +26 NEW MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE
- +27 NEW NEWIEN,I,J,X,Y,Z,WPCT
- +28 ;
- +29 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERRA^MAGGSERR"
- +30 IF ($DATA(MAGARRAY)<10)
- SET MAGRY(0)="0^No input data, Operation CANCELED"
- QUIT
- +31 ;
- +32 SET MAGRY(0)="0^Creating VistA Image Entry..."
- +33 SET MAGERR=""
- SET MAGGRP=0
- SET GRPCT=1
- SET WPCT=0
- +34 ; Validate the Data, and Action codes in the Input Array
- +35 DO VAL^MAGGSIV(.MAGRY,.MAGARRAY)
- IF 'MAGRY(0)
- QUIT
- +36 ;
- +37 ; Make the FileMan FDA array and the Imaging Action array.
- +38 DO MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP)
- +39 IF '$DATA(MAGGFDA(2005,"+1,"))
- SET MAGRY(0)="0^No data to file. Operation CANCELED."
- QUIT
- +40 ;
- +41 ;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43)))
- +42 ; Check on some possible problems: required fields, create default values etc.
- +43 DO PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF)
- IF $LENGTH(MAGERR)
- SET MAGRY(0)=MAGERR
- QUIT
- +44 ; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two.
- +45 ; SG - MAG*3*93
- SET (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12()
- +46 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- +47 ;
- +48 ; ERROR: QUIT
- +49 IF '$GET(MAGGIEN(1))
- Begin DoDot:1
- +50 SET MAGERR="0^ERROR Creating new Image File Entry "
- +51 IF $DATA(DIERR)
- DO RTRNERR^MAGGSIU1(.MAGERR)
- +52 DO CLEAN
- End DoDot:1
- SET MAGRY(0)=MAGERR
- QUIT
- +53 ;
- +54 SET MAGGDA=MAGGIEN(1)
- +55 ;
- +56 DO ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
- +57 ;
- +58 ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT
- +59 ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename
- +60 IF MAGGRP
- Begin DoDot:1
- +61 DO UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA)
- +62 SET MAGRY(0)=MAGGDA_U
- +63 DO CLEAN
- +64 QUIT
- End DoDot:1
- GOTO C1
- +65 ; ENTRY in Image File has been made, if any errors from here on
- +66 ; then we have to delete the image entry.
- +67 ; IF This image is a member of a Group, Update the Group Entry with new child.
- +68 SET X=$GET(MAGGFDA(2005,"+1,",14))
- IF +X
- Begin DoDot:1
- +69 DO UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA)
- +70 IF $LENGTH(MAGERR)
- SET MAGRY(0)=MAGERR
- DO CLEAN
- End DoDot:1
- IF $LENGTH(MAGERR)
- QUIT
- +71 ;
- +72 ; Now generate the Image FileName. This is passed back to the calling app,
- +73 ; and the calling app is responsible for renaming/copying the Image File to
- +74 ; this new name.
- +75 IF $DATA(MAGGFDA(2005,"+1,",1))
- SET MAGGFNM=MAGGFDA(2005,"+1,",1)
- +76 IF '$TEST
- Begin DoDot:1
- +77 NEW MAGXFDA
- +78 SET X=$$DA2NAME^MAGGTU1(MAGGDA,$GET(MAGACT("EXT")))
- IF 'X
- Begin DoDot:2
- +79 SET MAGERR=X
- +80 DO KILLENT^MAGGSIU1(MAGGDA)
- +81 DO CLEAN
- End DoDot:2
- QUIT
- +82 ;
- +83 SET MAGGFNM=$PIECE(X,U,2)
- SET Y=MAGGDA_","
- +84 SET MAGXFDA(2005,Y,1)=MAGGFNM
- +85 DO UPDATE^DIE("","MAGXFDA","","MAGGXE")
- +86 ; in case of an error
- +87 IF $DATA(DIERR)
- Begin DoDot:2
- +88 DO RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE)
- +89 DO KILLENT^MAGGSIU1(MAGGDA)
- +90 DO CLEAN
- End DoDot:2
- QUIT
- End DoDot:1
- IF $LENGTH(MAGERR)
- SET MAGRY(0)=MAGERR
- QUIT
- +91 ;
- C1 ; 59
- +1 ; P59.
- KILL MAGGFDA
- +2 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry
- +3 IF '$DATA(^MAG(2005,MAGGDA,40))
- Begin DoDot:1
- +4 NEW INDXD
- +5 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
- +6 DO COMIEN^MAGXCVC(MAGGDA,.INDXD)
- +7 ; Flag. Says fields were converted by index generation
- SET ^MAGIXCVT(2006.96,MAGGDA)=1
- +8 ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
- +9 ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108))
- +10 DO ACTION^MAGGTAU("INDEX-ALL^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$PIECE(^MAG(2005,MAGGDA,100),"^",5))
- +11 QUIT
- End DoDot:1
- +12 ;
- +13 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
- +14 IF '$PIECE(^MAG(2005,MAGGDA,40),"^",3)
- Begin DoDot:1
- +15 NEW INDXD,OLD40,N40
- +16 SET (N40,OLD40)=^MAG(2005,MAGGDA,40)
- +17 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
- +18 ; If Origin doesn't exist in existing, this will put V in.
- +19 IF $PIECE(INDXD,"^",6)=""
- SET $PIECE(INDXD,"^",6)="V"
- +20 ; We're not changing existing values of Spec,Proc or Origin
- +21 FOR J=1:1:6
- IF '$LENGTH($PIECE(N40,"^",J))
- SET $PIECE(N40,"^",J)=$PIECE(INDXD,"^",J)
- +22 ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
- +23 IF '$$VALINDEX^MAGGSIV1(.X,$PIECE(N40,"^",3),$PIECE(N40,"^",5),$PIECE(N40,"^",4))
- SET $PIECE(N40,"^",4,5)=$PIECE(OLD40,"^",4,5)
- +24 SET ^MAG(2005,MAGGDA,40)=N40
- +25 ;;D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
- +26 DO ACTION^MAGGTAU("INDEX-42^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$PIECE(^MAG(2005,MAGGDA,100),"^",5))
- +27 DO ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
- +28 QUIT
- End DoDot:1
- +29 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
- +30 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation
- +31 ;
- +32 ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG]
- +33 ; example: 487^C:\IMAGE\^DC000487.TIF
- +34 ; The calling routine is responsible for renaming/naming the file
- +35 ; to the returned DRIVE:\DIR\FILENAME.EXT
- +36 ;
- +37 ; Modified 4/23/98 to include hierarchical directory structure -- PMK
- +38 IF 'MAGGRP
- Begin DoDot:1
- +39 SET MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
- +40 ; For now, BIG files are in same directory as FullRes (or PACS) file
- +41 SET MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
- +42 ; If BIG file also, add it's Drive, Hash, Filename to end of Return string.
- +43 IF $GET(MAGACT("BIG"))
- Begin DoDot:2
- +44 SET X=$PIECE(MAGGFNM,".",1)_".BIG"
- +45 SET MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X
- +46 QUIT
- End DoDot:2
- +47 QUIT
- End DoDot:1
- +48 ;
- +49 NEW MAGOUT
- +50 ; add a new storage work item
- DO NWI2005^MAGNWRK1(.MAGOUT,MAGGDA)
- +51 ;
- CLEAN ; Called as tag
- +1 DO CLEAN^DILF
- +2 LOCK -^MAG(2005,NEWIEN)
- +3 QUIT