source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGBAPI.m@ 1604

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

initial load of WorldVistAEHR

File size: 9.5 KB
Line 
1MAGBAPI ;WOIFO/PMK,RMP,SEB,MLH - Background Processor API to build queues ; 08/26/2003 07:04
2 ;;3.0;IMAGING;**1,7,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 ;;
18 ; The API returns the entry's queue pointer
19 ;
20ABSTRACT(INPUT,PLACE) ; Entry point to create an image abstract
21 ; input = image pointer
22 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,INPUT,0)),U,2)) 0
23 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
24 Q $$QUEUE("ABSTRACT",INPUT,PLACE)
25 ;
26GCC(INPUT,PLACE) ; Entry point to create an Document Imaging Export Copy
27 ; input = image pointer(^Second Piece Optional Location specified^3rd optional extension(s) specifier)
28 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
29 Q $$QUEUE("GCC",$P(INPUT,"^")_"^^"_$P(INPUT,"^",4)_"^"_$P(INPUT,"^",2,3),PLACE)
30JUKEBOX(INPUT,PLACE) ; Entry point to copy an image file and abstract to the Jukebox
31 ; input = image pointer
32 N NEXT,CONS,GB
33 S GB=$G(^MAG(2005,INPUT,0))
34 S:GB="" GB=$G(^MAG(2005.1,INPUT,0))
35 Q:GB="" 0
36 Q:$$IMOFFLN^MAGFILEB($P(GB,U,2)) 0
37 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
38 S CONS=$$CONSOLID()
39 S NEXT=$O(^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),$$NEXTQ("JUKEBOX",PLACE)))
40 Q:NEXT?1N.N NEXT
41 S NEXT=$$QUEUE("JUKEBOX",INPUT,PLACE)
42 S ^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),NEXT)=""
43 Q NEXT
44DELETE(INPUT,PLACE) ; Entry point to delete a file (literally from anywhere)
45 ; input = full path of file to delete
46 N IMOD
47 S IMOD=$S(INPUT[U:"^^"_INPUT,1:"^^^"_INPUT)
48 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
49 Q $$QUEUE("DELETE",IMOD,PLACE) ;SETS 9TH & 10TH PIECE
50IMPORT(INPUT,CALLBACK,TRACKID,PLACE) ; Entry point to import a file
51 ; input = Image Parameter Array
52 ; Callback = the process called with the results of the import activity
53 N QUEIEN,INDX,FDA,DINUM,%,MS1,CT,REQUE,TMP
54 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE "0^Missing PLACE parameter" ; DBI - SEB Patch 4
55 S REQUE=$S($P($G(INPUT),"^",3)'?1N.N:0,1:1)
56 I REQUE=0 Q:($O(^MAG(2006.041,"C",TRACKID,""))?1N.N) "0^Duplicate Tracking ID"
57 S QUEIEN=$$QUEUE("IMPORT","^^"_$P($G(INPUT),"^",3)_U_$TR(CALLBACK,"^","|")_U_$P($G(INPUT),"^",4),PLACE)
58 I REQUE=0 D
59 . S $P(^MAGQUEUE(2006.03,QUEIEN,0),"^",11)=QUEIEN
60 . S (DINUM,X)=QUEIEN,DIC="^MAG(2006.034,",DLAYGO="2006.034",DIC(0)="L"
61 . D FILE^DICN
62 . K DIC
63 . S CT=0
64 . D CONV^MAGQBUT4(.INPUT,.CT)
65 . D MRGMULT^MAGQBUT4(.INPUT,"^MAG(2006.034,"_QUEIEN_",1,","2006.341A",CT)
66 D NOW^%DTC
67 K DIE,FDA
68 S FDA(2006.041,"+1,",.01)=$S(REQUE=0:QUEIEN,1:$P($G(INPUT),"^",4))
69 S FDA(2006.041,"+1,",.02)=TRACKID
70 S FDA(2006.041,"+1,",1)=$S(REQUE=0:"QUEUING",1:"REQUEUING")
71 S FDA(2006.041,"+1,",2)=%
72 D UPDATE^DIE("U","FDA","","MAGIMP")
73 I $D(DIERR) S TMP=MAGIMP("DIERR",1,"TEXT",1) K DIERR,MAGIMP
74 Q $S($D(TMP):"0^"_TMP,1:QUEIEN)
75 ;
76JBTOHD(INPUT,PLACE) ; Entry point to copy an image from the Jukebox to the Hard Disk
77 ; input = image pointer ^ FULL or ABSTRACT or BIG
78 N NEXT,IEN,JDTYPE,CONS
79 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
80 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
81 I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
82 E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
83 S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("JBTOHD",PLACE)))
84 Q:NEXT?1N.N NEXT
85 S NEXT=$$QUEUE("JBTOHD",INPUT,PLACE)
86 S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
87 Q NEXT
88 ;
89PREFET(INPUT,PLACE) ;
90 ; input = image pointer ^ FULL or ABSTRACT or BIG
91 N NEXT,IEN,JDTYPE,CONS
92 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
93 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
94 I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
95 E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
96 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
97 S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("PREFET",PLACE)))
98 Q:NEXT?1N.N NEXT
99 S NEXT=$$QUEUE("PREFET",INPUT,PLACE)
100 S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
101 Q NEXT
102 ;
103EVAL(IMAGE,PLACE) ; Entry point for before rules are evaluated
104 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
105 Q $$QUEUE("EVAL",IMAGE,PLACE)
106 ;
107NEXTQ(TYPE,PLACE) ;
108 N X
109 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
110 S X=$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
111 Q $S('X:X,1:$P(^MAGQUEUE(2006.031,X,0),"^",2))
112 ;
113QUEUE(Q,INPUT,PLACE) ; Stuff the entry (header + INPUT) into the appropriate queue (Q)
114 N %,%H,%I,QPTR,QTR,X,Y,STATUS
115 S U="^",STATUS="NOT_PROCESSED"
116 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
117 ; increment the QPTR
118 ;
119 L +^MAGQUEUE(2006.03,0)
120 S X=^MAGQUEUE(2006.03,0)
121 S QPTR=$O(^MAGQUEUE(2006.03," "),-1)+1
122 S QPTR=$S(QPTR<+$P(X,U,3):$P(X,U,3)+1,1:QPTR)
123 S $P(X,"^",3)=QPTR,$P(X,"^",4)=$P(X,"^",4)+1
124 S ^MAGQUEUE(2006.03,0)=X
125 D NOW^%DTC
126 S ^MAGQUEUE(2006.03,QPTR,0)=Q_"^"_$G(DUZ)_"^"_^%ZOSF("VOL")_"^"_%_"^"_STATUS_"^"_%_"^"_INPUT
127 S ^MAGQUEUE(2006.03,"C",PLACE,Q,QPTR)="",$P(^MAGQUEUE(2006.03,QPTR,0),"^",12)=PLACE
128 S ^MAGQUEUE(2006.03,"D",PLACE,Q,STATUS,QPTR)=""
129 L -^MAGQUEUE(2006.03,0)
130 D ADD(1,Q,PLACE)
131 Q QPTR
132ADD(N,QUEUE,PLACE) ;
133 ;
134 N CNT,D0,I,X,CONS,PREV,QTOT
135 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0
136 S D0=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
137 D:'D0
138 . L +^MAGQUEUE(2006.031)
139 . S D0=$O(^MAGQUEUE(2006.031," "),-1)+1
140 . S ^MAGQUEUE(2006.031,D0,0)=QUEUE_"^0^0^"_PLACE_U
141 . S ^MAGQUEUE(2006.031,"C",PLACE,QUEUE,D0)=""
142 . S X="IMAGE BACKGROUND QUEUE POINTER^2006.031^"_D0_"^"_D0
143 . S ^MAGQUEUE(2006.031,0)=X
144 . L -^MAGQUEUE(2006.031)
145 . Q
146 L +^MAGQUEUE(2006.031,D0)
147 S X=^MAGQUEUE(2006.031,D0,0),CNT=$P(X,U,3),PREV=$P(X,U,2),QTOT=$P(X,U,5)
148 I CNT?1.N S CNT=CNT+N
149 E D
150 . S I=$P(X,"^",2),CNT=0
151 . F S I=$O(^MAGQUEUE(2006.03,"C",PLACE,QUEUE,I)) Q:I'?1N.N S CNT=CNT+1
152 . Q
153 S $P(X,U,4)=PLACE
154 S:N>0 QTOT=QTOT+N
155 I QUEUE'["IMPORT",$D(QPTR),QPTR<(PREV+1) S $P(X,"^",2)=QPTR-1
156 S $P(X,U,3)=CNT,$P(X,U,5)=QTOT,^MAGQUEUE(2006.031,D0,0)=X
157 L -^MAGQUEUE(2006.031,D0)
158 Q
159CWL(PLACE) ;Current Write Location
160 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
161 Q $P($G(^MAG(2006.1,PLACE,0)),"^",3)
162PLACE(IEN) ;
163 Q $$GETPLACE(+$O(^MAG(2006.1,"B",IEN,"")))
164CWP(PLACE) ;Current Write Platter
165 N JBPTR
166 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
167 S JBPTR=$$JBPTR(PLACE) Q:'JBPTR 0
168 Q $P($G(^MAGQUEUE(2006.032,JBPTR,0)),"^",3)
169JBPTR(PLACE) ;Current JukeBox Pointer
170 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
171 Q $P($G(^MAG(2006.1,PLACE,1)),"^",6)
172GETPLACE(PLACE) ; Validate place
173 N SP
174 S SP=$G(PLACE)
175 S PLACE=+$S($$CONSOLID():+$G(PLACE),1:$O(^MAG(2006.1," "),-1))
176 I PLACE,$P($G(^MAG(2006.1,PLACE,0)),"^",1)="" S PLACE=0
177 I 'PLACE,$$MAXREP(10) D
178 . N I,MSG,S,T,J
179 . S MSG="Application process failure"
180 . S I=1,MSG(I)="Cannot determine 'place' (location, division, institution) for image."
181 . S T=$J("At",11) F S=$ST-1:-1:0 D
182 . . S I=I+1,MSG(I)=T_": "_$ST(S,"PLACE")_" = "_$ST(S,"MCODE"),T="Called From"
183 . . Q
184 . I $D(MAGARRAY) D
185 . . S J="",I=I+1,MSG(I)="MAGARRAY"
186 . . F S J=$O(MAGARRAY(J)) Q:J="" D
187 . . . S I=I+1,MSG(I)="MAGARRAY("_J_")"_MAGARRAY(J)
188 . . Q
189 . I $D(XWBTBUF) S I=I+1,MSG(I)="XWBTBUF: "_XWBTBUF
190 . I $D(MAGDA) S I=I+1,MSG(I)="MAGDA: "_MAGDA
191 . I $D(MAGGDA) S I=I+1,MSG(I)="MAGGDA: "_MAGGDA
192 . I $D(MAGGIEN("1")) S I=I+1,MSG(I)="MAGGIEN(""1""): "_MAGGIEN("1")
193 . S:$G(DUZ) I=I+1,MSG(I)="The USER was: "_$$GET1^DIQ(200,DUZ,".01","E")_" DUZ: "_DUZ
194 . S:$G(DUZ(2)) I=I+1,MSG(I)="The USER had a DUZ(2) setting of: "_DUZ(2)
195 . S I=I+1,MSG(I)="The original value of the INPUT Parameter 'PLACE' was: "_SP
196 . S I=I+1,MSG(I)="This fault may result in the failure to archive or process images."
197 . S I=I+1,MSG(I)="Please log a NOIS-call."
198 . S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0)
199 . D DFNIQ^MAGQBPG1("",MSG,1)
200 . Q
201 Q PLACE
202MAXREP(MAX) ;
203 N REP,CNT
204 I $P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,1)=$P($$NOW^XLFDT,".") D
205 . S CNT=+$P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,2)+1
206 . S REP=$S(CNT<MAX:1,1:0)
207 . S $P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)=CNT
208 E D
209 . I $D(^MAG(2006.1,"WARNING","MAGBAPI")) D
210 . . N I,MSG
211 . . S MSG="Application process failure Count"
212 . . S I=1,MSG(I)="On the following date: "_$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1)
213 . . S I=I+1,MSG(I)=$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)_" were logged on the host system"
214 . . S I=I+1,MSG(I)="The Vista Imaging Development and support team is being notified."
215 . . S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0)
216 . . D DFNIQ^MAGQBPG1("",MSG,1)
217 . . Q
218 . S REP=1,$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1,2)=$P($$NOW^XLFDT,".",1)_U_1
219 . Q
220 Q REP
221CONSOLID() ;
222 Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
223CONRPC(RESULT) ;[MAGG CONS]
224 S RESULT=$$CONSOLID^MAGBAPI()
225 Q
226PLACER(RESULT) ;[MAGG PLACE]
227 S RESULT=$$PLACE^MAGBAPI(+$G(DUZ(2)))
228 Q
229 ;
Note: See TracBrowser for help on using the repository browser.