Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGBAPI

MAGBAPI.m

Go to the documentation of this file.
  1. MAGBAPI ;WOIFO/PMK,RMP,SEB,MLH - Background Processor API to build queues ; 27 Aug 2014 5:12 PM
  1. ;;3.0;IMAGING;**1,7,8,20,39,154**;Mar 19, 2002;Build 9;Mar 08, 2011
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ; The API returns the entry's queue pointer
  1. ;
  1. ABSTRACT(INPUT,PLACE) ; Entry point to create an image abstract
  1. ; input = image pointer
  1. Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,INPUT,0)),U,2)) 0
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $$QUEUE("ABSTRACT",INPUT,PLACE)
  1. ;
  1. GCC(INPUT,PLACE) ; Entry point to create an Document Imaging Export Copy
  1. ; input = image pointer(^Second Piece Optional Location specified^3rd optional extension(s) specifier
  1. ; plus "~" separated alternate source file types
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $$QUEUE("GCC",$P(INPUT,"^")_"^^"_$P(INPUT,"^",4)_"^"_$P(INPUT,"^",2,3),PLACE)
  1. JUKEBOX(INPUT,PLACE) ; Entry point to copy an image file and abstract to the Jukebox / input = image pointer
  1. N NEXT,CONS,GB
  1. S GB=$G(^MAG(2005,+$P(INPUT,U),0))
  1. S:GB="" GB=$G(^MAG(2005.1,+$P(INPUT,U),0))
  1. Q:GB="" 0
  1. Q:$$IMOFFLN^MAGFILEB($P(GB,U,2)) 0
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. S CONS=$$CONSOLID()
  1. S NEXT=$O(^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),$$NEXTQ("JUKEBOX",PLACE)))
  1. Q:NEXT?1N.N NEXT
  1. S NEXT=$$QUEUE("JUKEBOX",INPUT,PLACE)
  1. Q:'NEXT NEXT
  1. S ^MAGQUEUE(2006.03,"E",PLACE,$P(INPUT,"^"),NEXT)=""
  1. Q NEXT
  1. DELETE(INPUT,PLACE) ; Entry point to delete a file (literally from anywhere) / input = full path of file to delete
  1. N IMOD
  1. S IMOD=$S(INPUT[U:"^^"_INPUT,1:"^^^"_INPUT)
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $$QUEUE("DELETE",IMOD,PLACE) ;SETS 9TH & 10TH PIECE
  1. IMPORT(INPUT,CALLBACK,TRACKID,PLACE) ; Entry point to import a file
  1. ; input = Image Parameter Array
  1. N QUEIEN,INDX,FDA,DINUM,MS1,CT,REQUE,TMP
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE "0^Missing PLACE parameter" ; DBI - SEB Patch 4
  1. S REQUE=$S($P($G(INPUT),"^",3)'?1N.N:0,1:1)
  1. I REQUE=0 Q:($O(^MAG(2006.041,"C",TRACKID,""))?1N.N) "0^Duplicate Tracking ID"
  1. S QUEIEN=$$QUEUE("IMPORT","^^"_$P($G(INPUT),"^",3)_U_$TR(CALLBACK,"^","|")_U_$P($G(INPUT),"^",4),PLACE)
  1. I REQUE=0 D
  1. . S $P(^MAGQUEUE(2006.03,QUEIEN,0),"^",11)=QUEIEN
  1. . S (DINUM,X)=QUEIEN,DIC="^MAG(2006.034,",DLAYGO="2006.034",DIC(0)="L"
  1. . K D0
  1. . D FILE^DICN
  1. . K DIC,D0,DLAYGO
  1. . S CT=0
  1. . D CONV^MAGQBUT4(.INPUT,.CT)
  1. . D MRGMULT^MAGQBUT4(.INPUT,"^MAG(2006.034,"_QUEIEN_",1,","2006.341A",CT)
  1. . Q
  1. K DIE,FDA
  1. S FDA(2006.041,"+1,",.01)=$S(REQUE=0:QUEIEN,1:$P($G(INPUT),"^",4))
  1. S FDA(2006.041,"+1,",.02)=TRACKID
  1. S FDA(2006.041,"+1,",1)=$S(REQUE=0:"QUEUING",1:"REQUEUING")
  1. S FDA(2006.041,"+1,",2)=$$NOW^XLFDT
  1. D UPDATE^DIE("U","FDA","","MAGIMP")
  1. I $D(DIERR) S TMP=MAGIMP("DIERR",1,"TEXT",1) K DIERR,MAGIMP
  1. Q $S($D(TMP):"0^"_TMP,1:QUEIEN)
  1. ;
  1. JBTOHD(INPUT,PLACE) ; Entry point to copy an image from the Jukebox to the Hard Disk
  1. ; input = image pointer ^ FULL or ABSTRACT or BIG
  1. N NEXT,IEN,JDTYPE,CONS
  1. S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
  1. Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
  1. I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
  1. E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("JBTOHD",PLACE)))
  1. Q:NEXT?1N.N NEXT
  1. S NEXT=$$QUEUE("JBTOHD",INPUT,PLACE)
  1. Q:'NEXT NEXT
  1. S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
  1. Q NEXT
  1. ;
  1. PREFET(INPUT,PLACE) ;
  1. ; input = image pointer ^ FULL or ABSTRACT or BIG
  1. N NEXT,IEN,JDTYPE,CONS
  1. S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
  1. Q:$$IMOFFLN^MAGFILEB($P($G(^MAG(2005,IEN,0)),U,2)) 0
  1. I 'PLACE S PLACE=$$DA2PLC^MAGBAPIP(IEN,$S(JDTYPE["ABSTRACT":"A",JDTYPE["BIG":"B",1:"F"))
  1. E S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. S IEN=$P(INPUT,"^"),JDTYPE=$P(INPUT,"^",2)
  1. S NEXT=$O(^MAGQUEUE(2006.03,"F",PLACE,IEN,JDTYPE,$$NEXTQ("PREFET",PLACE)))
  1. Q:NEXT?1N.N NEXT
  1. S NEXT=$$QUEUE("PREFET",INPUT,PLACE)
  1. Q:'NEXT NEXT
  1. S ^MAGQUEUE(2006.03,"F",PLACE,$P(INPUT,"^"),$P(INPUT,"^",2),NEXT)=""
  1. Q NEXT
  1. ;
  1. EVAL(IMAGE,PLACE) ; Entry point for before rules are evaluated
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $$QUEUE("EVAL",IMAGE,PLACE)
  1. ;
  1. NEXTQ(TYPE,PLACE) ;
  1. N X
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. S X=$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,""))
  1. Q $S('X:X,1:$P(^MAGQUEUE(2006.031,X,0),"^",2))
  1. ;
  1. QUEUE(Q,INPUT,PLACE) ; Stuff the entry (header + INPUT) into the appropriate queue (Q)
  1. N MAGTIME,QPTR,QTR,X,Y,STATUS,AQSQ
  1. S U="^",STATUS="NOT_PROCESSED"
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q:(((Q'["DELETE")&(Q'["IMPORT"))&($P(INPUT,U,1)'?1N.N)) 0
  1. ; increment the QPTR
  1. L +^MAGQUEUE(2006.03,0):1E9
  1. S X=^MAGQUEUE(2006.03,0)
  1. S QPTR=$O(^MAGQUEUE(2006.03," "),-1)+1
  1. S QPTR=$S(QPTR'>+$P(X,U,3):$P(X,U,3)+1,1:QPTR) ;p154
  1. S AQSQ=$O(^MAG(2006.041,"B"," "),-1)+1 ;p154
  1. I AQSQ>QPTR S QPTR=AQSQ ;p154
  1. S $P(X,"^",3)=QPTR,$P(X,"^",4)=$P(X,"^",4)+1
  1. S ^MAGQUEUE(2006.03,0)=X
  1. S MAGTIME=$$NOW^XLFDT
  1. S ^MAGQUEUE(2006.03,QPTR,0)=Q_"^"_$G(DUZ)_"^"_^%ZOSF("VOL")_"^"_MAGTIME_"^"_STATUS_"^"_MAGTIME_"^"_INPUT
  1. S ^MAGQUEUE(2006.03,"C",PLACE,Q,QPTR)="",$P(^MAGQUEUE(2006.03,QPTR,0),"^",12)=PLACE
  1. S ^MAGQUEUE(2006.03,"D",PLACE,Q,STATUS,QPTR)=""
  1. L -^MAGQUEUE(2006.03,0)
  1. D ADD(1,Q,PLACE)
  1. Q QPTR
  1. ADD(N,QUEUE,PLACE) ;
  1. ;
  1. N CNT,D0,I,X,CONS,PREV,QTOT
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0
  1. S D0=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
  1. D:'D0
  1. . L +^MAGQUEUE(2006.031):1E9
  1. . S D0=$O(^MAGQUEUE(2006.031," "),-1)+1
  1. . S ^MAGQUEUE(2006.031,D0,0)=QUEUE_"^0^0^"_PLACE_U
  1. . S ^MAGQUEUE(2006.031,"C",PLACE,QUEUE,D0)=""
  1. . S X="IMAGE BACKGROUND QUEUE POINTER^2006.031^"_D0_"^"_D0
  1. . S ^MAGQUEUE(2006.031,0)=X
  1. . L -^MAGQUEUE(2006.031)
  1. . Q
  1. L +^MAGQUEUE(2006.031,D0):1E9
  1. S X=^MAGQUEUE(2006.031,D0,0),CNT=$P(X,U,3),PREV=$P(X,U,2),QTOT=$P(X,U,5)
  1. I CNT?1.N S CNT=CNT+N
  1. E D
  1. . S I=$P(X,"^",2),CNT=0
  1. . F S I=$O(^MAGQUEUE(2006.03,"C",PLACE,QUEUE,I)) Q:I'?1N.N S CNT=CNT+1
  1. . Q
  1. S $P(X,U,4)=PLACE
  1. S:N>0 QTOT=QTOT+N
  1. ; In order to avoid the new queue from being skipped...
  1. I QUEUE'["IMPORT",$D(QPTR),QPTR<(PREV+1) S $P(X,"^",2)=QPTR-1,$P(X,"^",6)=$$NOW^XLFDT
  1. S $P(X,U,3)=CNT,$P(X,U,5)=QTOT,^MAGQUEUE(2006.031,D0,0)=X
  1. L -^MAGQUEUE(2006.031,D0)
  1. Q
  1. CWL(PLACE) ;Current Write Location
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $P($G(^MAG(2006.1,PLACE,0)),"^",3)
  1. PLACE(IEN) ;
  1. Q $$GETPLACE(+$O(^MAG(2006.1,"B",IEN,"")))
  1. JBPTR(PLACE) ;Current JukeBox Pointer
  1. S PLACE=$$GETPLACE($G(PLACE)) Q:'PLACE 0 ; DBI - SEB Patch 4
  1. Q $P($G(^MAG(2006.1,PLACE,1)),"^",6)
  1. GETPLACE(PLACE) ; Validate place
  1. N SP
  1. S SP=$G(PLACE)
  1. S PLACE=+$S($$CONSOLID():+$G(PLACE),1:$O(^MAG(2006.1," "),-1))
  1. I PLACE,$P($G(^MAG(2006.1,PLACE,0)),"^",1)="" S PLACE=0
  1. I 'PLACE,$$MAXREP(10) D
  1. . N I,MSG,S,T,J,PS
  1. . S PS=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")) ; PLACE of the VistA host system
  1. . S MSG="Application process failure"
  1. . S I=1,MSG(I)="Cannot determine 'place' (location, division, institution) for image."
  1. . S I=1,MSG(I)=" Production Account: "_$$PROD^XUPROD("1")
  1. . S T=$J("At",11) F S=$ST-1:-1:0 D
  1. . . S I=I+1,MSG(I)=T_": "_$ST(S,"PLACE")_" = "_$ST(S,"MCODE"),T="Called From"
  1. . . Q
  1. . I $D(MAGARRAY) D
  1. . . S J="",I=I+1,MSG(I)="MAGARRAY"
  1. . . F S J=$O(MAGARRAY(J)) Q:J="" D
  1. . . . S I=I+1,MSG(I)="MAGARRAY("_J_")"_MAGARRAY(J)
  1. . . Q
  1. . I $D(XWBTBUF) S I=I+1,MSG(I)="XWBTBUF: "_XWBTBUF
  1. . I $D(MAGDA) S I=I+1,MSG(I)="MAGDA: "_MAGDA
  1. . I $D(MAGGDA) S I=I+1,MSG(I)="MAGGDA: "_MAGGDA
  1. . I $D(MAGGIEN("1")) S I=I+1,MSG(I)="MAGGIEN(""1""): "_MAGGIEN("1")
  1. . S:$G(DUZ) I=I+1,MSG(I)="The USER was: "_$$GET1^DIQ(200,DUZ,".01","E")_" DUZ: "_DUZ
  1. . S:$G(DUZ(2)) I=I+1,MSG(I)="The USER had a DUZ(2) setting of: "_DUZ(2)
  1. . S I=I+1,MSG(I)="The original value of the INPUT Parameter 'PLACE' was: "_SP
  1. . S I=I+1,MSG(I)="This fault may result in the failure to archive or process images."
  1. . S I=I+1,MSG(I)="The users site of origin needs to have an Associated Institution value"
  1. . S I=I+1,MSG(I)="setup on the Site Parameters window."
  1. . S I=I+1,MSG(I)="refer to the BP User manual for instructions."
  1. . S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
  1. . D DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
  1. . Q
  1. Q PLACE
  1. MAXREP(MAX) ;
  1. N REP,CNT
  1. I $P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,1)=$$DT^XLFDT D
  1. . S CNT=+$P($G(^MAG(2006.1,"WARNING","MAGBAPI")),U,2)+1
  1. . S REP=$S(CNT<MAX:1,1:0)
  1. . S $P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)=CNT
  1. . Q
  1. E D
  1. . I $D(^MAG(2006.1,"WARNING","MAGBAPI")) D
  1. . . N I,MSG,PS
  1. . . S PS=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
  1. . . S MSG="Application process failure Count"
  1. . . S I=1,MSG(I)="On the following date: "_$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1)
  1. . . S I=I+1,MSG(I)=$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,2)_" were logged on the host system"
  1. . . S I=I+1,MSG(I)="The Vista Imaging Development and support team is being notified."
  1. . . S I="" F S I=$O(MSG(I)) Q:I="" D DFNIQ^MAGQBPG1("",MSG(I),0,PS,"$$GETPLACE_MAGBAPI")
  1. . . D DFNIQ^MAGQBPG1("",MSG,1,PS,"$$GETPLACE_MAGBAPI")
  1. . . Q
  1. . S REP=1,$P(^MAG(2006.1,"WARNING","MAGBAPI"),U,1,2)=$$DT^XLFDT_U_1
  1. . Q
  1. Q REP
  1. CWG(PL) ;Returns the Current RAID Group
  1. Q $P($G(^MAG(2006.1,PL,0)),U,10)
  1. CONSOLID() ;
  1. Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
  1. CONRPC(RESULT) ;[MAGG CONS]
  1. S RESULT=$$CONSOLID^MAGBAPI()
  1. Q
  1. PLACER(RESULT) ;[MAGG PLACE]
  1. S RESULT=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1. Q
  1. ;