source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGQBPG2.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1MAGQBPG2 ;WCIOFO - TS RMP Magnetic Server Purge processes [ 06/29/2001 18:28 ]
2 ;;3.0;IMAGING;**8,20**;Apr 12, 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 ;;
18CNP(RESULT,IEN) ; [MAGQ PCHKN]
19 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
20 N FNAME,PIECE,ZNODE,BNODE,BNAME,PTR,HASH
21 S IEN=+IEN,RESULT="^^^",U="^"
22 F S IEN=$O(^MAG(2005,IEN)) Q:IEN'?1N.N D Q:RESULT'="^^^"
23 . S ZNODE=$G(^MAG(2005,IEN,0))
24 . S FNAME=$P(ZNODE,U,2)
25 . I (FNAME["\")!(FNAME[":") D
26 . . S FNAME=$$FNX(FNAME)
27 . . S $P(^MAG(2005,IEN,0),U,2)=FNAME
28 . Q:$P(ZNODE,U,2)="" ;PROBABLE GROUP HEAD
29 . S BNODE=$G(^MAG(2005,IEN,"FBIG"))
30 . S PTR=$P(ZNODE,U,3) I PTR?1N.N D
31 . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
32 . . S $P(^MAG(2005,IEN,0),U,3)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
33 . . S $P(RESULT,"^")=$$JBPATH^MAGQBPRG(FNAME,PTR)
34 . S PTR=$P(ZNODE,U,4) I PTR?1N.N D
35 . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
36 . . S $P(^MAG(2005,IEN,0),U,4)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
37 . . S $P(RESULT,U,2)=$$JBPATH^MAGQBPRG($P(FNAME,".")_".ABS",PTR)
38 . S PTR=$P(BNODE,U) I PTR?1N.N D
39 . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
40 . . S $P(^MAG(2005,IEN,"FBIG"),U)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
41 . . S BNAME=$P(FNAME,".")_".BIG"
42 . . S $P(RESULT,"^",3)=$$JBPATH^MAGQBPRG(BNAME,PTR)
43 . I RESULT'="^^^" S $P(RESULT,U,4)=IEN ;IEN
44 Q
45FNX(NAME) ;FIX FILENAME
46 I NAME[":" S NAME=$P(NAME,":",$L(NAME,":"))
47 I NAME["\" S NAME=$P(NAME,"\",$L(NAME,"\"))
48 Q NAME
49CNPT ;
50 N IEN,RESULT,%
51 S IEN=0
52 D NOW^%DTC
53 F D CNP(.RESULT,.IEN) W:RESULT[":" !,RESULT Q:IEN'?1N.N D
54 . S IEN=$P(RESULT,"^",4)
55 Q
56PGEPAR(RESULT) ; RPC[MAGQBP PARM]
57 ;; RECORD PurgeParam
58 ;; Status^MinAbs^MinFull^MinBig^ABS^PACABS^FULL^PACS^BIG^PACSBIG^RADHOLD
59 ;; ^FilePrefix
60 ;; FULL:8,PACS:9,PACSBIG:21,BIG:22,ABS:23,ABSPACS:24,RADHOLDS:13
61 N ABS,FULL,PACSABS,PACS,BIG,PACSBIG,MINABS,MINFULL,MINBIG,PREFIX,NODE3
62 N FILE,PLACE,FIELD,FLAGS
63 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
64 S NODE3=$G(^MAG(2006.1,PLACE,3))
65 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
66 S U="^"
67 S FILE=2006.1,FIELD="8;9;13;21;22;23;24",FLAGS="E"
68 D GETS^DIQ(FILE,PLACE,FIELD,FLAGS,"ARR","ERR")
69 S FULL=+ARR(2006.1,PLACE_",",8,"E"),TFULL(FULL)=""
70 S ABS=+ARR(2006.1,PLACE_",",23,"E"),TABS(ABS)=""
71 S PACS=+ARR(2006.1,PLACE_",",9,"E"),TFULL(PACS)=""
72 S PACSABS=+ARR(2006.1,PLACE_",",24,"E"),TABS(PACSABS)=""
73 S PACSBIG=+ARR(2006.1,PLACE_",",21,"E"),TBIG(PACSBIG)=""
74 S BIG=+ARR(2006.1,PLACE_",",22,"E"),TBIG(BIG)=""
75 S MINABS=+$O(TABS(0)),MINFULL=+$O(TFULL(0)),MINBIG=+$O(TBIG(0))
76 S PREFIX=$$INIS(PLACE)
77 K TABS,TFULL,TBIG
78 S RESULT="1"_U_MINABS_U_MINFULL_U_MINBIG_U_ABS_U_PACSABS_U_FULL_U_PACS
79 S RESULT=RESULT_U_BIG_U_PACSBIG_U_+ARR(2006.1,PLACE_",",13,"E")_U_PREFIX
80 Q
81 ;;
82PGEUD(RESULT,FILENAME,EXT,IEN,DEVICE) ; RPC[MAGQBP UPDATE]
83 N FTYPE,NODE,PIECE,PLACE
84 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
85 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
86 S RESULT="0",FTYPE=$$FTYPE^MAGQBPRG(EXT)
87 ;I $P($G(^MAG(2006.1,PLACE,"JBEX")),U,5) D IMAGEDEL^MAGGTID(.RESULT,IEN) Q
88 S NODE=$S(FTYPE="BIG":"FBIG",1:0)
89 S:DEVICE="JB" PIECE=$S(FTYPE="ABS":5,FTYPE="BIG":2,FTYPE="FULL":5,1:0)
90 S:DEVICE="NET" PIECE=$S(FTYPE="ABS":4,FTYPE="BIG":1,FTYPE="FULL":3,1:0)
91 I PIECE=0 D ELOG^MAGQBPRG(NODE,FTYPE) Q
92 S RESULT="1"
93 S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=""
94 S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=""
95 Q
96INIS(PLACE) ;
97 N ARRY,CNT,SUB,RESULT
98 S ARRY($P($G(^MAG(2006.1,PLACE,0)),"^",2))=""
99 S CNT=0
100 F S CNT=$O(^MAG(2006.1,PLACE,4,CNT)) Q:CNT'?1N.N D
101 . S ARRY(^MAG(2006.1,PLACE,4,CNT,0))=""
102 S (SUB,RESULT)=""
103 F S SUB=$O(ARRY(SUB)) Q:SUB="" D
104 . S RESULT=$S(RESULT="":SUB,1:(RESULT_","_SUB))
105 K ARRY
106 Q RESULT
Note: See TracBrowser for help on using the repository browser.