source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGBAPI.m@ 1154

MAGBAPI ;WOIFO/PMK,RMP,SEB,MLH - Background Processor API to build queues ; 08/26/2003  07:04
 ;;3.0;IMAGING;**1,7,8,20**;Apr 12, 2006
 ;; +---------------------------------------------------------------+
 ;; | 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.                     |
 ;; +---------------------------------------------------------------+
 ;;
 ; The API returns the entry's queue pointer
 ;
ABSTRACT(INPUT,PLACE) ; Entry point to create an image abstract
 ; input = image pointer
 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,INPUT,0)),U,2)) 0
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $$QUEUE("ABSTRACT",INPUT,PLACE)
 ;
GCC(INPUT,PLACE) ; Entry point to create an Document Imaging Export Copy
 ; input = image pointer(^Second Piece Optional Location specified^3rd optional extension(s) specifier)
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $$QUEUE("GCC",$P(INPUT,"^")_"^^"_$P(INPUT,"^",4)_"^"_$P(INPUT,"^",2,3),PLACE)
JUKEBOX(INPUT,PLACE) ; Entry point to copy an image file and abstract to the Jukebox
 ; input = image pointer
 N NEXT,CONS,GB
 S GB=$G(^MAG(2005,INPUT,0))
 S:GB="" GB=$G(^MAG(2005.1,INPUT,0))
 Q:GB="" 0
 Q:$$IMOFFLN^MAGFILEB($P(GB,U,2)) 0
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 S CONS=$$CONSOLID()
 S NEXT=$O(^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),$$NEXTQ("JUKEBOX",PLACE)))
 Q:NEXT?1N.N NEXT
 S NEXT=$$QUEUE("JUKEBOX",INPUT,PLACE)
 S ^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),NEXT)=""
 Q NEXT
DELETE(INPUT,PLACE) ; Entry point to delete a file (literally from anywhere)
 ; input = full path of file to delete
 N IMOD
 S IMOD=$S(INPUT[U:"^^"_INPUT,1:"^^^"_INPUT)
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $$QUEUE("DELETE",IMOD,PLACE) ;SETS 9TH & 10TH PIECE
IMPORT(INPUT,CALLBACK,TRACKID,PLACE) ; Entry point to import a file
 ; input = Image Parameter Array
 ; Callback = the process called with the results of the import activity
 N QUEIEN,INDX,FDA,DINUM,%,MS1,CT,REQUE,TMP
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE "0^Missing PLACE parameter" ; DBI - SEB Patch 4
 S REQUE=$S($P($G(INPUT),"^",3)'?1N.N:0,1:1)
 I REQUE=0 Q:($O(^MAG(2006.041,"C",TRACKID,""))?1N.N) "0^Duplicate Tracking ID"
 S QUEIEN=$$QUEUE("IMPORT","^^"_$P($G(INPUT),"^",3)_U_$TR(CALLBACK,"^","|")_U_$P($G(INPUT),"^",4),PLACE)
 I REQUE=0 D
 . S $P(^MAGQUEUE(2006.03,QUEIEN,0),"^",11)=QUEIEN
 . S (DINUM,X)=QUEIEN,DIC="^MAG(2006.034,",DLAYGO="2006.034",DIC(0)="L"
 . D FILE^DICN
 . K DIC
 . S CT=0
 . D CONV^MAGQBUT4(.INPUT,.CT)
 . D MRGMULT^MAGQBUT4(.INPUT,"^MAG(2006.034,"_QUEIEN_",1,","2006.341A",CT)
 D NOW^%DTC
 K DIE,FDA
 S FDA(2006.041,"+1,",.01)=$S(REQUE=0:QUEIEN,1:$P($G(INPUT),"^",4))
 S FDA(2006.041,"+1,",.02)=TRACKID
 S FDA(2006.041,"+1,",1)=$S(REQUE=0:"QUEUING",1:"REQUEUING")
 S FDA(2006.041,"+1,",2)=%
 D UPDATE^DIE("U","FDA","","MAGIMP")
 I $D(DIERR) S TMP=MAGIMP("DIERR",1,"TEXT",1) K DIERR,MAGIMP
 Q $S($D(TMP):"0^"_TMP,1:QUEIEN)
 ;
JBTOHD(INPUT,PLACE) ; Entry point to copy an image from the Jukebox to the Hard Disk
 ; input = image pointer ^ FULL or ABSTRACT or BIG
 N NEXT,IEN,JDTYPE,CONS
 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
 I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
 E  S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("JBTOHD",PLACE)))
 Q:NEXT?1N.N NEXT
 S NEXT=$$QUEUE("JBTOHD",INPUT,PLACE)
 S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
 Q NEXT
 ;
PREFET(INPUT,PLACE) ;
 ; input = image pointer ^ FULL or ABSTRACT or BIG
 N NEXT,IEN,JDTYPE,CONS
 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
 Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
 I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
 E  S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
 S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("PREFET",PLACE)))
 Q:NEXT?1N.N NEXT
 S NEXT=$$QUEUE("PREFET",INPUT,PLACE)
 S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
 Q NEXT
 ;
EVAL(IMAGE,PLACE) ; Entry point for before rules are evaluated
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $$QUEUE("EVAL",IMAGE,PLACE)
 ;
NEXTQ(TYPE,PLACE) ;
 N X
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 S X=$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
 Q $S('X:X,1:$P(^MAGQUEUE(2006.031,X,0),"^",2))
 ;
QUEUE(Q,INPUT,PLACE) ; Stuff the entry (header + INPUT) into the appropriate queue (Q)
 N %,%H,%I,QPTR,QTR,X,Y,STATUS
 S U="^",STATUS="NOT_PROCESSED"
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 ; increment the QPTR
 ;
 L +^MAGQUEUE(2006.03,0)
 S X=^MAGQUEUE(2006.03,0)
 S QPTR=$O(^MAGQUEUE(2006.03," "),-1)+1
 S QPTR=$S(QPTR<+$P(X,U,3):$P(X,U,3)+1,1:QPTR)
 S $P(X,"^",3)=QPTR,$P(X,"^",4)=$P(X,"^",4)+1
 S ^MAGQUEUE(2006.03,0)=X
 D NOW^%DTC
 S ^MAGQUEUE(2006.03,QPTR,0)=Q_"^"_$G(DUZ)_"^"_^%ZOSF("VOL")_"^"_%_"^"_STATUS_"^"_%_"^"_INPUT
 S ^MAGQUEUE(2006.03,"C",PLACE,Q,QPTR)="",$P(^MAGQUEUE(2006.03,QPTR,0),"^",12)=PLACE
 S ^MAGQUEUE(2006.03,"D",PLACE,Q,STATUS,QPTR)=""
 L -^MAGQUEUE(2006.03,0)
 D ADD(1,Q,PLACE)
 Q QPTR
ADD(N,QUEUE,PLACE) ;
 ;
 N CNT,D0,I,X,CONS,PREV,QTOT
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0
 S D0=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
 D:'D0
 . L +^MAGQUEUE(2006.031)
 . S D0=$O(^MAGQUEUE(2006.031," "),-1)+1
 . S ^MAGQUEUE(2006.031,D0,0)=QUEUE_"^0^0^"_PLACE_U
 . S ^MAGQUEUE(2006.031,"C",PLACE,QUEUE,D0)=""
 . S X="IMAGE BACKGROUND QUEUE POINTER^2006.031^"_D0_"^"_D0
 . S ^MAGQUEUE(2006.031,0)=X
 . L -^MAGQUEUE(2006.031)
 . Q
 L +^MAGQUEUE(2006.031,D0)
 S X=^MAGQUEUE(2006.031,D0,0),CNT=$P(X,U,3),PREV=$P(X,U,2),QTOT=$P(X,U,5)
 I CNT?1.N S CNT=CNT+N
 E  D
 . S I=$P(X,"^",2),CNT=0
 . F  S I=$O(^MAGQUEUE(2006.03,"C",PLACE,QUEUE,I)) Q:I'?1N.N  S CNT=CNT+1
 . Q
 S $P(X,U,4)=PLACE
 S:N>0 QTOT=QTOT+N
 I QUEUE'["IMPORT",$D(QPTR),QPTR<(PREV+1) S $P(X,"^",2)=QPTR-1
 S $P(X,U,3)=CNT,$P(X,U,5)=QTOT,^MAGQUEUE(2006.031,D0,0)=X
 L -^MAGQUEUE(2006.031,D0)
 Q
CWL(PLACE) ;Current Write Location
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $P($G(^MAG(2006.1,PLACE,0)),"^",3)
PLACE(IEN) ;
 Q $$GETPLACE(+$O(^MAG(2006.1,"B",IEN,"")))
CWP(PLACE) ;Current Write Platter
 N JBPTR
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 S JBPTR=$$JBPTR(PLACE) Q:'JBPTR 0
 Q $P($G(^MAGQUEUE(2006.032,JBPTR,0)),"^",3)
JBPTR(PLACE) ;Current JukeBox Pointer
 S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
 Q $P($G(^MAG(2006.1,PLACE,1)),"^",6)
GETPLACE(PLACE) ; Validate place
 N SP
 S SP=$G(PLACE)
 S PLACE=+$S($$CONSOLID():+$G(PLACE),1:$O(^MAG(2006.1," "),-1))
 I PLACE,$P($G(^MAG(2006.1,PLACE,0)),"^",1)="" S PLACE=0
 I 'PLACE,$$MAXREP(10) D
 . N I,MSG,S,T,J
 . S MSG="Application process failure"
 . S I=1,MSG(I)="Cannot determine 'place' (location, division, institution) for image."
 . S T=$J("At",11) F S=$ST-1:-1:0 D
 . . S I=I+1,MSG(I)=T_": "_$ST(S,"PLACE")_" = "_$ST(S,"MCODE"),T="Called From"
 . . Q
 . I $D(MAGARRAY) D
 . . S J="",I=I+1,MSG(I)="MAGARRAY"
 . . F  S J=$O(MAGARRAY(J)) Q:J=""  D
 . . . S I=I+1,MSG(I)="MAGARRAY("_J_")"_MAGARRAY(J)
 . . Q
 . I $D(XWBTBUF) S I=I+1,MSG(I)="XWBTBUF: "_XWBTBUF
 . I $D(MAGDA) S I=I+1,MSG(I)="MAGDA: "_MAGDA
 . I $D(MAGGDA) S I=I+1,MSG(I)="MAGGDA: "_MAGGDA
 . I $D(MAGGIEN("1")) S I=I+1,MSG(I)="MAGGIEN(""1""): "_MAGGIEN("1")
 . S:$G(DUZ) I=I+1,MSG(I)="The USER was: "_$$GET1^DIQ(200,DUZ,".01","E")_" DUZ: "_DUZ
 . S:$G(DUZ(2)) I=I+1,MSG(I)="The USER had a DUZ(2) setting of: "_DUZ(2)
 . S I=I+1,MSG(I)="The original value of the INPUT Parameter 'PLACE' was: "_SP
 . S I=I+1,MSG(I)="This fault may result in the failure to archive or process images."
 . S I=I+1,MSG(I)="Please log a NOIS-call."
 . S I="" F  S I=$O(MSG(I)) Q:I=""  D DFNIQ^MAGQBPG1("",MSG(I),0)
 . D DFNIQ^MAGQBPG1("",MSG,1)
 . Q
 Q PLACE
MAXREP(MAX) ;
 N REP,CNT
 I $P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,1)=$P($$NOW^XLFDT,".") D
 . S CNT=+$P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,2)+1
 . S REP=$S(CNT<MAX:1,1:0)
 . S $P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)=CNT
 E  D
 . I $D(^MAG(2006.1,"WARNING","MAGBAPI")) D
 . . N I,MSG
 . . S MSG="Application process failure Count"
 . . S I=1,MSG(I)="On the following date: "_$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1)
 . . S I=I+1,MSG(I)=$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)_" were logged on the host system"
 . . S I=I+1,MSG(I)="The Vista Imaging Development and support team is being notified."
 . . S I="" F  S I=$O(MSG(I)) Q:I=""  D DFNIQ^MAGQBPG1("",MSG(I),0)
 . . D DFNIQ^MAGQBPG1("",MSG,1)
 . . Q
 . S REP=1,$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1,2)=$P($$NOW^XLFDT,".",1)_U_1
 . Q
 Q REP
CONSOLID() ;
 Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
CONRPC(RESULT) ;[MAGG CONS]
 S RESULT=$$CONSOLID^MAGBAPI()
 Q
PLACER(RESULT) ;[MAGG PLACE]
 S RESULT=$$PLACE^MAGBAPI(+$G(DUZ(2)))
 Q
 ;