- MAGGTIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; Dec 05, 2018@1:42pm
- ;;3.0;IMAGING;**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
- ADD ;Now call Fileman to file the data
- N NEWIEN,MAGGDA,X,Y
- ;~~~ Delete this comment and the following line of code when
- ; the IMAGE AUDIT file (#2005.1) is completely eliminated.
- ; Because we delete the Image node on image deletion, we have to
- ; check the last entry in Audit File, to see if it is greater
- ;~~~ than the last image in the Image File.
- 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)
- ; we know that MAGGIEN WILL contain the internal number.
- ; after the call.
- ;
- I $G(MAGMOD) D Q ; WE'LL QUIT AFTER MODIFICATION
- . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- . S MAGRY="1^OK"
- . ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
- . D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN
- ;
- S (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12() ; SG - MAG*3*93
- D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- ;
- I '$G(MAGGIEN(1)) D S MAGRY=MAGERR Q
- . S MAGERR="0^ERROR Creating new Image File Entry "
- . I $D(DIERR) D RTRNERR(.MAGERR)
- . D CLEAN
- ;
- S MAGGDA=MAGGIEN(1)
- ;
- D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
- ;
- ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
- ; we'll do this by hand, Else it'll take forever.
- ; we Return the IEN with NO Filename. Groups don't get Filename
- ;
- I MAGGR S MAGRY=MAGGDA_U,Z="" D G C1
- . F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA
- . D CLEAN
- ;
- S X=$G(MAGGFDA(2005,"+1,",14)) I +X D
- . ; If here: This image is a member of a Group
- . ; -Modify the Group Parent, add DA to it's group
- . ; -Also set 'Series Number' and 'Image Number' if they exist;
- . K MAGGFDA
- . S Y="+2,"_X_","
- . S MAGGFDA(2005.04,Y,.01)=MAGGDA
- . ; GEK 4/4/00 ADDED $L( we were dying on "0"
- . I $L($G(MAGDCMSN)) S MAGGFDA(2005.04,Y,1)=MAGDCMSN
- . I $L($G(MAGDCMIN)) S MAGGFDA(2005.04,Y,2)=MAGDCMIN
- . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- ;
- ; Now get the Image file name. DOS FILE name
- ; The ENTRY in Image File has been made, if any errors from here on
- ; then we have to delete the image entry.
- I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1
- K MAGGFDA
- S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGGEXT)) I 'X D S MAGRY=MAGERR Q
- . S MAGERR=X
- . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
- . K DA,DIC,DIK
- . D CLEAN
- S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
- S MAGGFDA(2005,Y,1)=MAGGFNM
- D UPDATE^DIE("","MAGGFDA","","MAGGXE")
- ; shouldn't have an error just editing one entry, but just in case.
- I $D(DIERR) D S MAGRY=MAGERR Q
- . D RTRNERR(.MAGERR)
- . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
- . K DA,DIC,DIK
- . D CLEAN
- ;
- C1 ; we jump here if we already had a Filename sent
- K MAGGFDA
- ; New Index Field Check. If this entry doesn't have the Index fields introduced
- ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
- ;
- ;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)
- . S ^MAG(2005,MAGGDA,40)=INDXD
- . S ^MAGIXCVT(2006.96,MAGGDA)=2 ; Flag. Says fields were converted Patch 59
- . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
- . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
- . D ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
- . 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,J,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 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.
- ;** IT IS DONE IN A SEPERATE CALL
- ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
- ;** the workstation
- ;
- ; Queue it to be copied to Jukebox.
- ; CREATE ABSTRACT
- ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
- I $G(MAGGABS)="YES" S X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
- ; RESTORE AFTER GLOBAL SETUP
- I $G(MAGGJB)="YES" S X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
- ; Code for setting a Queue to Copy BIG to JUKEBOX
- ;
- ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
- ; example: 487^C:\IMAGE\^DC000487.TIF
- ; The calling routine is responsible for renaming/naming the file
- ; to the returned DRIVE:\DIR\FILENAME.EXT
- ; 4/23/98 to include hierarchical directory structure -- PMK
- ;
- I 'MAGGR D
- . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
- . S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
- . ; For now, BIG files are in same directory as FullRes (or PACS) file
- . I $G(MAGBIG) D
- . . S X=$P(MAGGFNM,".",1)_".BIG"
- . . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
- . . Q
- . Q
- ;
- N MAGOUT
- D NWI2005^MAGNWRK1(.MAGOUT,MAGGDA) ; add a new storage work item
- ;
- CLEAN ;
- D CLEAN^DILF
- L -^MAG(2005,NEWIEN)
- Q
- RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
- S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
- Q
- ERR ; Error trap
- S MAGRY="0^ERROR "_$$EC^%ZOSV
- D @^%ZOSF("ERRTN")
- Q
- MAKENAME() ; MAGGFDA exists so get info from that.
- ; We'll make NAME (.01) with PATIENT NAME SSN
- ; DOCUMENT Imaging was making name of
- ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
- N Z,ZT,ZNAME,ZSSN,ZDESC
- ; GEK 10/10/2000
- ; Modifying this procedure to make same name for all Image types
- ; The name will be (first 18 chars of patient Name) _ SSN
- I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
- I $D(MAGGFDA(2005,"+1,",5)) D
- . S X=MAGGFDA(2005,"+1,",5)
- . S ZNAME=$P(^DPT(X,0),U),ZSSN=$P(^DPT(X,0),U,9)
- ;
- ; For all Images the name is first 18 characters of patient name
- ; concatenated with SSN. If No patient name is sent, well make
- ; the name from the short desc.
- I $D(ZNAME) S Z=$E(ZNAME,1,18)_" "_ZSSN
- E S Z=ZDESC
- Q Z
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTIA1 7896 printed Feb 18, 2025@23:29:26 Page 2
- MAGGTIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; Dec 05, 2018@1:42pm
- +1 ;;3.0;IMAGING;**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
- ADD ;Now call Fileman to file the data
- +1 NEW NEWIEN,MAGGDA,X,Y
- +2 ;~~~ Delete this comment and the following line of code when
- +3 ; the IMAGE AUDIT file (#2005.1) is completely eliminated.
- +4 ; Because we delete the Image node on image deletion, we have to
- +5 ; check the last entry in Audit File, to see if it is greater
- +6 ;~~~ than the last image in the Image File.
- +7 IF ($ORDER(^MAG(2005,"A"),-1)<$ORDER(^MAG(2005.1,"A"),-1))
- SET $PIECE(^MAG(2005,0),U,3)=$ORDER(^MAG(2005.1,"A"),-1)
- +8 ; we know that MAGGIEN WILL contain the internal number.
- +9 ; after the call.
- +10 ;
- +11 ; WE'LL QUIT AFTER MODIFICATION
- IF $GET(MAGMOD)
- Begin DoDot:1
- +12 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- +13 SET MAGRY="1^OK"
- +14 ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
- +15 ; This is the Image IEN
- DO ACTION^MAGGTAU("MOD^"_$PIECE(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$GET(MAGMOD))
- End DoDot:1
- QUIT
- +16 ;
- +17 ; SG - MAG*3*93
- SET (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12()
- +18 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- +19 ;
- +20 IF '$GET(MAGGIEN(1))
- Begin DoDot:1
- +21 SET MAGERR="0^ERROR Creating new Image File Entry "
- +22 IF $DATA(DIERR)
- DO RTRNERR(.MAGERR)
- +23 DO CLEAN
- End DoDot:1
- SET MAGRY=MAGERR
- QUIT
- +24 ;
- +25 SET MAGGDA=MAGGIEN(1)
- +26 ;
- +27 DO ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
- +28 ;
- +29 ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
- +30 ; we'll do this by hand, Else it'll take forever.
- +31 ; we Return the IEN with NO Filename. Groups don't get Filename
- +32 ;
- +33 IF MAGGR
- SET MAGRY=MAGGDA_U
- SET Z=""
- Begin DoDot:1
- +34 FOR
- SET Z=$ORDER(MAGGR(Z))
- if Z=""
- QUIT
- SET $PIECE(^MAG(2005,Z,0),U,10)=MAGGDA
- +35 DO CLEAN
- End DoDot:1
- GOTO C1
- +36 ;
- +37 SET X=$GET(MAGGFDA(2005,"+1,",14))
- IF +X
- Begin DoDot:1
- +38 ; If here: This image is a member of a Group
- +39 ; -Modify the Group Parent, add DA to it's group
- +40 ; -Also set 'Series Number' and 'Image Number' if they exist;
- +41 KILL MAGGFDA
- +42 SET Y="+2,"_X_","
- +43 SET MAGGFDA(2005.04,Y,.01)=MAGGDA
- +44 ; GEK 4/4/00 ADDED $L( we were dying on "0"
- +45 IF $LENGTH($GET(MAGDCMSN))
- SET MAGGFDA(2005.04,Y,1)=MAGDCMSN
- +46 IF $LENGTH($GET(MAGDCMIN))
- SET MAGGFDA(2005.04,Y,2)=MAGDCMIN
- +47 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
- End DoDot:1
- +48 ;
- +49 ; Now get the Image file name. DOS FILE name
- +50 ; The ENTRY in Image File has been made, if any errors from here on
- +51 ; then we have to delete the image entry.
- +52 IF $DATA(MAGGFDA(2005,"+1,",1))
- SET MAGGFNM=MAGGFDA(2005,"+1,",1)
- GOTO C1
- +53 KILL MAGGFDA
- +54 SET X=$$DA2NAME^MAGGTU1(MAGGDA,$GET(MAGGEXT))
- IF 'X
- Begin DoDot:1
- +55 SET MAGERR=X
- +56 SET DA=MAGGDA
- SET DIK="^MAG(2005,"
- DO ^DIK
- +57 KILL DA,DIC,DIK
- +58 DO CLEAN
- End DoDot:1
- SET MAGRY=MAGERR
- QUIT
- +59 SET MAGGFNM=$PIECE(X,U,2)
- SET Y=MAGGDA_","
- +60 SET MAGGFDA(2005,Y,1)=MAGGFNM
- +61 DO UPDATE^DIE("","MAGGFDA","","MAGGXE")
- +62 ; shouldn't have an error just editing one entry, but just in case.
- +63 IF $DATA(DIERR)
- Begin DoDot:1
- +64 DO RTRNERR(.MAGERR)
- +65 SET DA=MAGGDA
- SET DIK="^MAG(2005,"
- DO ^DIK
- +66 KILL DA,DIC,DIK
- +67 DO CLEAN
- End DoDot:1
- SET MAGRY=MAGERR
- QUIT
- +68 ;
- C1 ; we jump here if we already had a Filename sent
- +1 KILL MAGGFDA
- +2 ; New Index Field Check. If this entry doesn't have the Index fields introduced
- +3 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
- +4 ;
- +5 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry.
- +6 IF '$DATA(^MAG(2005,MAGGDA,40))
- Begin DoDot:1
- +7 NEW INDXD
- +8 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
- +9 SET ^MAG(2005,MAGGDA,40)=INDXD
- +10 ; Flag. Says fields were converted Patch 59
- SET ^MAGIXCVT(2006.96,MAGGDA)=2
- +11 ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
- +12 ;_"$$"_MAGGFDA(2005,"+1,",108))
- DO ACTION^MAGGTAU("INDEX-ALL^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA)
- +13 DO ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
- +14 QUIT
- End DoDot:1
- +15 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
- +16 IF '$PIECE(^MAG(2005,MAGGDA,40),"^",3)
- Begin DoDot:1
- +17 NEW INDXD,J,OLD40,N40
- +18 SET (N40,OLD40)=^MAG(2005,MAGGDA,40)
- +19 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
- +20 ; If Origin doesn't exist in existing, this will put V in.
- +21 IF $PIECE(INDXD,"^",6)=""
- SET $PIECE(INDXD,"^",6)="V"
- +22 ; We're not changing existing values of Spec,Proc or Origin
- +23 FOR J=1:1:6
- IF '$LENGTH($PIECE(N40,"^",J))
- SET $PIECE(N40,"^",J)=$PIECE(INDXD,"^",J)
- +24 ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
- +25 IF '$$VALINDEX^MAGGSIV1(.X,$PIECE(N40,"^",3),$PIECE(N40,"^",5),$PIECE(N40,"^",4))
- SET $PIECE(N40,"^",4,5)=$PIECE(OLD40,"^",4,5)
- +26 SET ^MAG(2005,MAGGDA,40)=N40
- +27 ;_"$$"_MAGGFDA(2005,"+1,",108))
- DO ACTION^MAGGTAU("INDEX-42^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA)
- +28 DO ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
- +29 QUIT
- End DoDot:1
- +30 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
- +31 ;** IT IS DONE IN A SEPERATE CALL
- +32 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
- +33 ;** the workstation
- +34 ;
- +35 ; Queue it to be copied to Jukebox.
- +36 ; CREATE ABSTRACT
- +37 ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
- +38 IF $GET(MAGGABS)="YES"
- SET X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
- +39 ; RESTORE AFTER GLOBAL SETUP
- +40 IF $GET(MAGGJB)="YES"
- SET X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
- +41 ; Code for setting a Queue to Copy BIG to JUKEBOX
- +42 ;
- +43 ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
- +44 ; example: 487^C:\IMAGE\^DC000487.TIF
- +45 ; The calling routine is responsible for renaming/naming the file
- +46 ; to the returned DRIVE:\DIR\FILENAME.EXT
- +47 ; 4/23/98 to include hierarchical directory structure -- PMK
- +48 ;
- +49 IF 'MAGGR
- Begin DoDot:1
- +50 SET MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
- +51 SET MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
- +52 ; For now, BIG files are in same directory as FullRes (or PACS) file
- +53 IF $GET(MAGBIG)
- Begin DoDot:2
- +54 SET X=$PIECE(MAGGFNM,".",1)_".BIG"
- +55 SET MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
- +56 QUIT
- End DoDot:2
- +57 QUIT
- End DoDot:1
- +58 ;
- +59 NEW MAGOUT
- +60 ; add a new storage work item
- DO NWI2005^MAGNWRK1(.MAGOUT,MAGGDA)
- +61 ;
- CLEAN ;
- +1 DO CLEAN^DILF
- +2 LOCK -^MAG(2005,NEWIEN)
- +3 QUIT
- RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
- +1 SET ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
- +2 QUIT
- ERR ; Error trap
- +1 SET MAGRY="0^ERROR "_$$EC^%ZOSV
- +2 DO @^%ZOSF("ERRTN")
- +3 QUIT
- MAKENAME() ; MAGGFDA exists so get info from that.
- +1 ; We'll make NAME (.01) with PATIENT NAME SSN
- +2 ; DOCUMENT Imaging was making name of
- +3 ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
- +4 NEW Z,ZT,ZNAME,ZSSN,ZDESC
- +5 ; GEK 10/10/2000
- +6 ; Modifying this procedure to make same name for all Image types
- +7 ; The name will be (first 18 chars of patient Name) _ SSN
- +8 IF $DATA(MAGGFDA(2005,"+1,",10))
- SET ZDESC=$EXTRACT(MAGGFDA(2005,"+1,",10),1,30)
- +9 IF $DATA(MAGGFDA(2005,"+1,",5))
- Begin DoDot:1
- +10 SET X=MAGGFDA(2005,"+1,",5)
- +11 SET ZNAME=$PIECE(^DPT(X,0),U)
- SET ZSSN=$PIECE(^DPT(X,0),U,9)
- End DoDot:1
- +12 ;
- +13 ; For all Images the name is first 18 characters of patient name
- +14 ; concatenated with SSN. If No patient name is sent, well make
- +15 ; the name from the short desc.
- +16 IF $DATA(ZNAME)
- SET Z=$EXTRACT(ZNAME,1,18)_" "_ZSSN
- +17 IF '$TEST
- SET Z=ZDESC
- +18 QUIT Z