MAGQBD.m

MAGQBD ;WOIFO/PMK/RMP - Arbitrary file deletion ; 18 Jan 2011 4:18 PM

 ;;3.0;IMAGING;**20,39**;Mar 19, 2002;Build 2010;Mar 08, 2011

 ;; 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

ENTRY(RESULT,QPTR) ; entry point from MAGQBTM

 N FILE,X,IEN,FN,ARCH,NODE,PLACE,GB,CJB,CJBP

 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),(GB,ARCH)=""

 S U="^",X=^MAGQUEUE(2006.03,QPTR,0)

 S FILE=$P(X,"^",10)

 S FN=$P(FILE,"\",$L(FILE,"\"))

 S IEN=$O(^MAG(2005.1,"F",$P(FN,"."),""))

 I 'IEN S RESULT="-1"_U_QPTR_U_"No 2005.1 Entry established for Image file: "_$P(FN,".")_U_U Q

 S NODE=$G(^MAG(2005.1,IEN,0))

 I $P(FILE,".",2)'["BIG" S ARCH=$S($P(NODE,U,5):$P(NODE,U,5),1:"")

 E  S ARCH=$S($P($G(^MAG(2005.1,IEN,"FBIG")),U,2):$P($G(^MAG(2005.1,IEN,"FBIG")),U,2),1:"")

 S CJB=$$JBPTR^MAGBAPI($$PLACE^MAGBAPI(+$G(DUZ(2))))

 S CJBP=$$UPPER^MAGQE4($P($G(^MAG(2005.2,CJB,0)),U,2)_$$DIRHASH^MAGFILEB(FN,CJB))

 S GB=$S(ARCH:$$UPPER^MAGQE4($P($G(^MAG(2005.2,ARCH,0)),U,2)_$$DIRHASH^MAGFILEB(FN,ARCH)),1:"")

 I ($L(GB)<1)&($L(CJBP)<1) S RESULT="-1"_U_QPTR_U_"No Archive Global established for entry: "_IEN_U_QPTR_U_U

 E  S RESULT="1"_U_FILE_U_QPTR_U_+$P(X,U,9)_U_GB_U_IEN_U_ARCH_U_CJB_U_CJBP

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGQBD   2130     printed  Mar 13, 2025@21:12:40                                                                                                                                                                                                      Page 2

MAGQBD    ;WOIFO/PMK/RMP - Arbitrary file deletion ; 18 Jan 2011 4:18 PM

 +1       ;;3.0;IMAGING;**20,39**;Mar 19, 2002;Build 2010;Mar 08, 2011

 +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 

ENTRY(RESULT,QPTR) ; entry point from MAGQBTM

 +1        NEW FILE,X,IEN,FN,ARCH,NODE,PLACE,GB,CJB,CJBP

 +2        SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))

           SET (GB,ARCH)=""

 +3        SET U="^"

           SET X=^MAGQUEUE(2006.03,QPTR,0)

 +4        SET FILE=$PIECE(X,"^",10)

 +5        SET FN=$PIECE(FILE,"\",$LENGTH(FILE,"\"))

 +6        SET IEN=$ORDER(^MAG(2005.1,"F",$PIECE(FN,"."),""))

 +7        IF 'IEN

               SET RESULT="-1"_U_QPTR_U_"No 2005.1 Entry established for Image file: "_$PIECE(FN,".")_U_U

               QUIT 

 +8        SET NODE=$GET(^MAG(2005.1,IEN,0))

 +9        IF $PIECE(FILE,".",2)'["BIG"

               SET ARCH=$SELECT($PIECE(NODE,U,5):$PIECE(NODE,U,5),1:"")

 +10      IF '$TEST

               SET ARCH=$SELECT($PIECE($GET(^MAG(2005.1,IEN,"FBIG")),U,2):$PIECE($GET(^MAG(2005.1,IEN,"FBIG")),U,2),1:"")

 +11       SET CJB=$$JBPTR^MAGBAPI($$PLACE^MAGBAPI(+$GET(DUZ(2))))

 +12       SET CJBP=$$UPPER^MAGQE4($PIECE($GET(^MAG(2005.2,CJB,0)),U,2)_$$DIRHASH^MAGFILEB(FN,CJB))

 +13       SET GB=$SELECT(ARCH:$$UPPER^MAGQE4($PIECE($GET(^MAG(2005.2,ARCH,0)),U,2)_$$DIRHASH^MAGFILEB(FN,ARCH)),1:"")

 +14       IF ($LENGTH(GB)<1)&($LENGTH(CJBP)<1)

               SET RESULT="-1"_U_QPTR_U_"No Archive Global established for entry: "_IEN_U_QPTR_U_U

 +15      IF '$TEST

               SET RESULT="1"_U_FILE_U_QPTR_U_+$PIECE(X,U,9)_U_GB_U_IEN_U_ARCH_U_CJB_U_CJBP

 +16       QUIT