MAGGNTI ;WOIFO/GEK/SG/NST/JSL - Imaging interface to TIU RPC Calls etc. ; 20 Jan 2010 10:08 AM
;;3.0;IMAGING;**10,8,59,93,108,122,129**;Mar 19, 2002;Build 4607;May 10, 2013
;; 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
FILE(MAGRY,MAGDA,TIUDA) ;RPC [MAG3 TIU IMAGE]
; Call to file TIU and Imaging Pointers
; TIU API to add image to TIU
N X
;Patch 108
; Create a new TIU note if TIUDA equals zero
I (TIUDA=0),'$$SETTIUDA(.MAGRY,MAGDA,.TIUDA) Q
I $P(^TIU(8925,TIUDA,0),U,2)'=$P(^MAG(2005,MAGDA,0),U,7) S MAGRY="0^Patient Mismatch." Q
D PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA) ;
I 'MAGRY Q
; Now SET the Parent fields in the Image File
S $P(^MAG(2005,MAGDA,2),U,6,8)=8925_U_TIUDA_U_+MAGRY
; DONE.
S MAGRY="1^Image pointer filed successfully"
; Now we save the PARENT ASSOCIATION Date/Time
D LINKDT^MAGGTU6(.X,MAGDA)
Q
DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA]
; Call to get TIU data from the TIUDA
; MAGRY: returns data from fields .01,1201,.02,1202 , .05
; .01 1201 .02 1202
; TIUDA^Document Type ^Document Date^DFN^Author DUZ^Status
;
; - old code
;S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I")_U_$$GET1^DIQ(8925,TIUDA,"1202","I")_U
;
;P122 we need 1 if Status is Complete 0 otherwise. Status is field .05
; reformat code for easier reading, and add the 1 or 0 as 6th piece.
;
N RES,CDA,ST
D GETS^DIQ(8925,TIUDA,".01;1201;.02;1202;.05","EI","RES")
I '$D(RES) S MAGRY="" Q ;no TIU data
S CDA=TIUDA_","
S $P(MAGRY,U,1)=TIUDA
S $P(MAGRY,U,2)=RES(8925,CDA,".01","E") ; Document Type
S $P(MAGRY,U,3)=RES(8925,CDA,"1201","I") ;Document Date
S $P(MAGRY,U,4)=RES(8925,CDA,".02","I") ;DFN
S $P(MAGRY,U,5)=RES(8925,CDA,"1202","I") ;Author DUZ
; P122 Return Status as 6th piece of Result String
S $P(MAGRY,U,6)=RES(8925,CDA,".05","E") ; Status
S $P(MAGRY,U,7)="" ; future
S $P(MAGRY,U,8)=$$ISADDNDM^TIULC1(TIUDA) ; NEW FOR 129T12
S $P(MAGRY,U,9)="" ; put's "^" on end of string.
Q
IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE]
; Call to get all images for a given TIU DA
; We first get all Image IEN's breaking groups into separate images
; Then get Image Info for each one.
; MAGRY - Return array of Image Data entries
; MAGRY(0) is 1 ^ message if successful
; 0 ^ Error message if error;
; TIUDA is IEN in ^TIU(8925
;
; Call TIU API to get list of Image IEN's
N MAGARR,CT,TCT,I,J,Z K ^TMP($J,"MAGGX")
N DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT
N TIUDFN,MAGQUIT ; MAGQI 8/22/01
N MAGFILE ; MAGFILE is returned from MAGGTII
;
S MAGQUIT=0 ; MAGQI 8/22/01
S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) ;MAGQI 8/22/01
I 'TIUDFN S MAGRY(0)="0^Invalid Patient DFN for Note ID: '"_TIUDA_"'"
D GETILST^TIUSRVPL(.MAGARR,TIUDA)
S CT=0,TCT=0
; Now get all images for all groups and single images.
S I="" F S I=$O(MAGARR(I)) Q:'I S DA=MAGARR(I) D ;Q:MAGQUIT
. S Z=$$ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_Z Q
. ; Check that array of images from selected TIUDA have
. ; same patient's and valid backward pointers
. I $P($G(^MAG(2005,DA,0)),U,7)'=TIUDFN S MAGQUIT=1,MAGNCHK="Patient Mismatch. TIU: "_TIUDA
. I $P($G(^MAG(2005,DA,2)),U,7)'=TIUDA S MAGQUIT=1,MAGNCHK="Pointer Mismatch. TIU: "_TIUDA
. I MAGQUIT S MAGXX=DA,MAGFILE=$$INFO^MAGGAII(MAGXX,"E") D Q ; D INFO^MAGGTII
. . ; remove the Abstract and Image File Names ; 2/14/03 p8t14 remove c:\program files. with .\bmp\
. . S $P(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
. . ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
. . S $P(MAGFILE,U,6)=$S(($P(MAGFILE,U,6)'=11):"99",1:11)
. . S $P(MAGFILE,U,10)="M"
. . ;Send the error message
. . S $P(MAGFILE,U,17)=MAGNCHK
. . S TCT=TCT+1,MAGRY(TCT)="B2^"_MAGFILE
. ;
. I $O(^MAG(2005,DA,1,0)) D Q
. . ; Integrity check, if group is questionable, add it's ien to list, not it's
. . ; children. Later when list is looped through, it's $$INFO^MAGGAII(MAGXX,"E") will be in
. . ; list. Have to do this to allow other images in list from TIU to be processed.
. . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP($J,"MAGGX",CT)=DA Q
. . S J=0 ; the following line needs to take only the first piece of the node - PMK 4/4/02
. . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP($J,"MAGGX",CT)=$P(^(J,0),"^")
. S CT=CT+1
. S ^TMP($J,"MAGGX",CT)=DA
; Now get image info for each image
;
S Z=""
S MAGQUIET=1
F S Z=$O(^TMP($J,"MAGGX",Z)) Q:Z="" D
. S TCT=TCT+1,MAGXX=^TMP($J,"MAGGX",Z)
. ;GEK 8/24/00 Stopping the Invalid Image IEN's and Deleted Images
. I '$D(^MAG(2005,MAGXX)) D Q
. . D INVALID^MAGGTIG(MAGXX,.MAGRSLT) S MAGRY(CT)=MAGRSLT
. ;D INFO^MAGGTII
. S MAGFILE=$$INFO^MAGGAII(MAGXX,"E")
. S MAGRY(TCT)="B2^"_MAGFILE
K MAGQUIET
S MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE"
; Put the Image IEN of the last image into the group IEN field.
Q:'TCT
S $P(MAGRY(0),U,3)=TIUDA
K MAGRSLT
D DATA(.MAGRSLT,TIUDA)
S $P(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$P(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($P(MAGRSLT,U,3),"8")
;
S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U),$G(MAGXX):MAGXX,1:0)
Q
;
ISDELIMG(MAGIEN) ; Is this a deleted Image.
N ERR,MAGR,MAGT,Z
;--- Check the image status
I '$$ISDEL^MAGGI11(MAGIEN,.ERR) D Q:$G(MAGT)="" MAGR
. I ERR'<0 S MAGR="0^Valid Image" Q
. I +ERR=-43 S MAGR="0^Image IEN exists, and is Deleted !" Q
. S MAGR="Invalid Image pointer",MAGT=67
. Q
E S MAGR="Deleted Image",MAGT=66
;--- Special processing for deleted images and errors
S $P(Z,U,1,4)=MAGIEN_U_"-1~"_MAGR_U_"-1~"_MAGR_U_MAGR
S $P(Z,U,6)=MAGT
;--- This stops client from changing Abstract BMP to OFFLINE IMAGE
S $P(Z,U,10)="M"
;--- Return the error message
S $P(Z,U,17)=$P(MAGR,U,2)
Q Z
;
ISDOCCL(MAGRY,IEN,TIUFILE,CLASS) ;RPC [MAGG IS DOC CLASS]
;Checks to see if IEN of TIU Files 8925 or 8925.1 is of a certain Doc Class
;MAGRY = Return String
; for Success "1^message"
; for Failure "0^message"
;IEN = Internal Entry Number in the TIUFILE
;TIUFILE = either 8925 if we need to see if a Note is of a Document Class
; or 8925.1 if we need to see if a Title is of a Document Class
;CLASS = Text Name of the Document Class example: "ADVANCE DIRECTIVE"
;
S MAGRY="0^Unknown Error checking TIU Document Class"
K MAGTRGT,DEFIEN,DOCCL,RES,DONE,NTTL
S DONE=0
; If we're resolving a Title
I TIUFILE="8925.1" D Q:DONE
. S DEFIEN=IEN,NTTL="Title"
. I '$D(^TIU(8925.1,DEFIEN,0)) S MAGRY="0^Invalid Title IEN",DONE=1 Q
. Q
; If we're resolving a Note
I TIUFILE="8925" D Q:DONE
. S NTTL="Note"
. I '$D(^TIU(8925,IEN)) S MAGRY="0^Invalid Note IEN",DONE=1 Q
. ; Get Title IEN from Note IEN
. S DEFIEN=$$GET1^DIQ(8925,IEN_",",.01,"I")
. I DEFIEN="" S MAGRY="0^Error resolving Document Class from Note IEN" S DONE=1 Q
. Q
;
; Find the IEN in 8925.1 for Document Class (CLASS)
D FIND^DIC(8925.1,"","@;.001","X",CLASS,"","","I $P(^(0),U,4)=""DC""","","MAGTRGT")
S DOCCL=$G(MAGTRGT("DILIST",2,1))
;
; See if ^TIU(8925.1,DEFIEN is of Document Class DOCCL
S RES=$$ISA^TIULX(DEFIEN,DOCCL)
I RES S MAGRY="1^The "_NTTL_" is of Document Class "_CLASS Q
S MAGRY="0^The "_NTTL_" is Not of Document Class "_CLASS
Q
;
; *******************
; Patch 108
; Create a new TIU stub using data in ^MAG(2006.82 by Tracking ID
; In this way BP doesn't need to be recompiled
;
; Return Values
; =============
; 0 for failure
; 1 for success
;
; MAGRY
; for failure "0^message"
; for success "TIU Note IEN^message"
; TIUDA - TIU Note IEN
;
; Input Parameters
; ================
; MAGDA - Image IEN in file #2005
;
SETTIUDA(MAGRY,MAGDA,TIUDA) ;
N TRKID,TIUTTL,TIUTCNT
N MAGTEXT,MAGDFN,MAGADCL,MAGMODE,MAGES,MAGESBY,MAGDATE
N MAGIAPI,TIUIEN
S TRKID=$$GET1^DIQ(2005,MAGDA,"108") ; Tracking ID - it is unique
I TRKID="" S MAGRY="0^TIUDA equals zero and Tracking ID is not found." Q 0
; Get import data
D GETIAPID^MAGGSIUI(.MAGIAPI,TRKID)
I '$D(MAGIAPI) S MAGRY="0^TIUDA equals zero and no data found by Tracking ID." Q 0 ; no data quit
S TIUTTL=$G(MAGIAPI("PXTIUTTL")) ; Get TIU Title
; Validate TIU Title
I '$$GETTIUDA^MAGGSIV(.MAGRY,TIUTTL,.TIUIEN) Q 0
S TIUTTL=TIUIEN ; set TIUTTL to internal TIU Title in case the external value is provided
; Get Text
S TIUTCNT=+$G(MAGIAPI("PXTIUTCNT")) ; TIU note Text Lines Count
F I=0:1:TIUTCNT-1 D
. S MAGTEXT(I)=$G(MAGIAPI("PXTIUTXT"_$TR($J(I,5)," ",0))) ; Get Text Lines
. Q
S MAGTEXT(TIUTCNT)=" VistA Imaging Import API - Imported Document"
S MAGDFN=$$GET1^DIQ(2005,MAGDA,"5","I") ; Patient DFN
S MAGADCL=+$G(MAGIAPI("PXSGNTYP")) ; Signature Type - 0 unsigned/ 1 Admin closed/ 2 Signed
S MAGMODE="E"
S MAGES=""
S MAGESBY=$$GET1^DIQ(2005,MAGDA,"8","I") ; Image Capture by ( Signed)
S MAGDATE=$G(MAGIAPI("PXDT")) ; TIU note Date
; Create a new TIU note
D NEW^MAGGNTI1(.MAGRY,MAGDFN,TIUTTL,MAGADCL,MAGMODE,MAGES,MAGESBY,"",MAGDATE,"",.MAGTEXT)
I $P(MAGRY,"^") S TIUDA=+MAGRY D UPDPKG^MAGGNTI(MAGDA,TIUDA) Q 1
Q 0
;
; *******************
; Patch 108
; Update Package Index (#40) in #2005 based on TIU Note info.
;
; Input Parameters
; ================
; MAGDA - Image IEN in file #2005
; PXIEN - TIU Note IEN in file #8925
;
UPDPKG(MAGDA,PXIEN) ;Patch 108: Update Package Index (#40) in #2005 based on TIU Note info.
N PKG,MAGRY,OK,MAGGFDA,MAGGXE,MAGNOFMAUDIT
S PKG=$$GET1^DIQ(2005,MAGDA_",",40)
I PKG'="NONE" Q ; Quit if the package is already set to something else than "NONE"
S PKG=""
D DATA^MAGGNTI(.MAGRY,PXIEN)
D ISCP^TIUCP(.OK,$P(MAGRY,U,2)) I OK S PKG="CP"
I PKG="" D ISCNSLT^TIUCNSLT(.OK,$P(MAGRY,U,2)) I OK S PKG="CONS"
I PKG="" S PKG="NOTE"
S MAGGFDA(2005,MAGDA_",",40)=PKG
S MAGNOFMAUDIT=1 ; Do not file the changes in Audit file.
; We are not done with initial setup
D UPDATE^DIE("","MAGGFDA","","MAGGXE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGNTI 11183 printed Apr 09, 2024@21:02:24 Page 2
MAGGNTI ;WOIFO/GEK/SG/NST/JSL - Imaging interface to TIU RPC Calls etc. ; 20 Jan 2010 10:08 AM
+1 ;;3.0;IMAGING;**10,8,59,93,108,122,129**;Mar 19, 2002;Build 4607;May 10, 2013
+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
FILE(MAGRY,MAGDA,TIUDA) ;RPC [MAG3 TIU IMAGE]
+1 ; Call to file TIU and Imaging Pointers
+2 ; TIU API to add image to TIU
+3 NEW X
+4 ;Patch 108
+5 ; Create a new TIU note if TIUDA equals zero
+6 IF (TIUDA=0)
IF '$$SETTIUDA(.MAGRY,MAGDA,.TIUDA)
QUIT
+7 IF $PIECE(^TIU(8925,TIUDA,0),U,2)'=$PIECE(^MAG(2005,MAGDA,0),U,7)
SET MAGRY="0^Patient Mismatch."
QUIT
+8 ;
DO PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA)
+9 IF 'MAGRY
QUIT
+10 ; Now SET the Parent fields in the Image File
+11 SET $PIECE(^MAG(2005,MAGDA,2),U,6,8)=8925_U_TIUDA_U_+MAGRY
+12 ; DONE.
+13 SET MAGRY="1^Image pointer filed successfully"
+14 ; Now we save the PARENT ASSOCIATION Date/Time
+15 DO LINKDT^MAGGTU6(.X,MAGDA)
+16 QUIT
DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA]
+1 ; Call to get TIU data from the TIUDA
+2 ; MAGRY: returns data from fields .01,1201,.02,1202 , .05
+3 ; .01 1201 .02 1202
+4 ; TIUDA^Document Type ^Document Date^DFN^Author DUZ^Status
+5 ;
+6 ; - old code
+7 ;S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I")_U_$$GET1^DIQ(8925,TIUDA,"1202","I")_U
+8 ;
+9 ;P122 we need 1 if Status is Complete 0 otherwise. Status is field .05
+10 ; reformat code for easier reading, and add the 1 or 0 as 6th piece.
+11 ;
+12 NEW RES,CDA,ST
+13 DO GETS^DIQ(8925,TIUDA,".01;1201;.02;1202;.05","EI","RES")
+14 ;no TIU data
IF '$DATA(RES)
SET MAGRY=""
QUIT
+15 SET CDA=TIUDA_","
+16 SET $PIECE(MAGRY,U,1)=TIUDA
+17 ; Document Type
SET $PIECE(MAGRY,U,2)=RES(8925,CDA,".01","E")
+18 ;Document Date
SET $PIECE(MAGRY,U,3)=RES(8925,CDA,"1201","I")
+19 ;DFN
SET $PIECE(MAGRY,U,4)=RES(8925,CDA,".02","I")
+20 ;Author DUZ
SET $PIECE(MAGRY,U,5)=RES(8925,CDA,"1202","I")
+21 ; P122 Return Status as 6th piece of Result String
+22 ; Status
SET $PIECE(MAGRY,U,6)=RES(8925,CDA,".05","E")
+23 ; future
SET $PIECE(MAGRY,U,7)=""
+24 ; NEW FOR 129T12
SET $PIECE(MAGRY,U,8)=$$ISADDNDM^TIULC1(TIUDA)
+25 ; put's "^" on end of string.
SET $PIECE(MAGRY,U,9)=""
+26 QUIT
IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE]
+1 ; Call to get all images for a given TIU DA
+2 ; We first get all Image IEN's breaking groups into separate images
+3 ; Then get Image Info for each one.
+4 ; MAGRY - Return array of Image Data entries
+5 ; MAGRY(0) is 1 ^ message if successful
+6 ; 0 ^ Error message if error;
+7 ; TIUDA is IEN in ^TIU(8925
+8 ;
+9 ; Call TIU API to get list of Image IEN's
+10 NEW MAGARR,CT,TCT,I,J,Z
KILL ^TMP($JOB,"MAGGX")
+11 NEW DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT
+12 ; MAGQI 8/22/01
NEW TIUDFN,MAGQUIT
+13 ; MAGFILE is returned from MAGGTII
NEW MAGFILE
+14 ;
+15 ; MAGQI 8/22/01
SET MAGQUIT=0
+16 ;MAGQI 8/22/01
SET TIUDFN=$PIECE($GET(^TIU(8925,TIUDA,0)),U,2)
+17 IF 'TIUDFN
SET MAGRY(0)="0^Invalid Patient DFN for Note ID: '"_TIUDA_"'"
+18 DO GETILST^TIUSRVPL(.MAGARR,TIUDA)
+19 SET CT=0
SET TCT=0
+20 ; Now get all images for all groups and single images.
+21 ;Q:MAGQUIT
SET I=""
FOR
SET I=$ORDER(MAGARR(I))
if 'I
QUIT
SET DA=MAGARR(I)
Begin DoDot:1
+22 SET Z=$$ISDELIMG(DA)
IF Z
SET TCT=TCT+1
SET MAGRY(TCT)="B2^"_Z
QUIT
+23 ; Check that array of images from selected TIUDA have
+24 ; same patient's and valid backward pointers
+25 IF $PIECE($GET(^MAG(2005,DA,0)),U,7)'=TIUDFN
SET MAGQUIT=1
SET MAGNCHK="Patient Mismatch. TIU: "_TIUDA
+26 IF $PIECE($GET(^MAG(2005,DA,2)),U,7)'=TIUDA
SET MAGQUIT=1
SET MAGNCHK="Pointer Mismatch. TIU: "_TIUDA
+27 ; D INFO^MAGGTII
IF MAGQUIT
SET MAGXX=DA
SET MAGFILE=$$INFO^MAGGAII(MAGXX,"E")
Begin DoDot:2
+28 ; remove the Abstract and Image File Names ; 2/14/03 p8t14 remove c:\program files. with .\bmp\
+29 SET $PIECE(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
+30 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
+31 SET $PIECE(MAGFILE,U,6)=$SELECT(($PIECE(MAGFILE,U,6)'=11):"99",1:11)
+32 SET $PIECE(MAGFILE,U,10)="M"
+33 ;Send the error message
+34 SET $PIECE(MAGFILE,U,17)=MAGNCHK
+35 SET TCT=TCT+1
SET MAGRY(TCT)="B2^"_MAGFILE
End DoDot:2
QUIT
+36 ;
+37 IF $ORDER(^MAG(2005,DA,1,0))
Begin DoDot:2
+38 ; Integrity check, if group is questionable, add it's ien to list, not it's
+39 ; children. Later when list is looped through, it's $$INFO^MAGGAII(MAGXX,"E") will be in
+40 ; list. Have to do this to allow other images in list from TIU to be processed.
+41 DO CHK^MAGGSQI(.MAGQI,DA)
IF 'MAGQI(0)
SET CT=CT+1
SET ^TMP($JOB,"MAGGX",CT)=DA
QUIT
+42 ; the following line needs to take only the first piece of the node - PMK 4/4/02
SET J=0
+43 FOR
SET J=$ORDER(^MAG(2005,DA,1,J))
if 'J
QUIT
SET CT=CT+1
SET ^TMP($JOB,"MAGGX",CT)=$PIECE(^(J,0),"^")
End DoDot:2
QUIT
+44 SET CT=CT+1
+45 SET ^TMP($JOB,"MAGGX",CT)=DA
End DoDot:1
+46 ; Now get image info for each image
+47 ;
+48 SET Z=""
+49 SET MAGQUIET=1
+50 FOR
SET Z=$ORDER(^TMP($JOB,"MAGGX",Z))
if Z=""
QUIT
Begin DoDot:1
+51 SET TCT=TCT+1
SET MAGXX=^TMP($JOB,"MAGGX",Z)
+52 ;GEK 8/24/00 Stopping the Invalid Image IEN's and Deleted Images
+53 IF '$DATA(^MAG(2005,MAGXX))
Begin DoDot:2
+54 DO INVALID^MAGGTIG(MAGXX,.MAGRSLT)
SET MAGRY(CT)=MAGRSLT
End DoDot:2
QUIT
+55 ;D INFO^MAGGTII
+56 SET MAGFILE=$$INFO^MAGGAII(MAGXX,"E")
+57 SET MAGRY(TCT)="B2^"_MAGFILE
End DoDot:1
+58 KILL MAGQUIET
+59 SET MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE"
+60 ; Put the Image IEN of the last image into the group IEN field.
+61 if 'TCT
QUIT
+62 SET $PIECE(MAGRY(0),U,3)=TIUDA
+63 KILL MAGRSLT
+64 DO DATA(.MAGRSLT,TIUDA)
+65 SET $PIECE(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$PIECE(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($PIECE(MAGRSLT,U,3),"8")
+66 ;
+67 SET $PIECE(MAGRY(0),U,5)=$SELECT($PIECE($GET(MAGFILE),U):$PIECE(MAGFILE,U),$GET(MAGXX):MAGXX,1:0)
+68 QUIT
+69 ;
ISDELIMG(MAGIEN) ; Is this a deleted Image.
+1 NEW ERR,MAGR,MAGT,Z
+2 ;--- Check the image status
+3 IF '$$ISDEL^MAGGI11(MAGIEN,.ERR)
Begin DoDot:1
+4 IF ERR'<0
SET MAGR="0^Valid Image"
QUIT
+5 IF +ERR=-43
SET MAGR="0^Image IEN exists, and is Deleted !"
QUIT
+6 SET MAGR="Invalid Image pointer"
SET MAGT=67
+7 QUIT
End DoDot:1
if $GET(MAGT)=""
QUIT MAGR
+8 IF '$TEST
SET MAGR="Deleted Image"
SET MAGT=66
+9 ;--- Special processing for deleted images and errors
+10 SET $PIECE(Z,U,1,4)=MAGIEN_U_"-1~"_MAGR_U_"-1~"_MAGR_U_MAGR
+11 SET $PIECE(Z,U,6)=MAGT
+12 ;--- This stops client from changing Abstract BMP to OFFLINE IMAGE
+13 SET $PIECE(Z,U,10)="M"
+14 ;--- Return the error message
+15 SET $PIECE(Z,U,17)=$PIECE(MAGR,U,2)
+16 QUIT Z
+17 ;
ISDOCCL(MAGRY,IEN,TIUFILE,CLASS) ;RPC [MAGG IS DOC CLASS]
+1 ;Checks to see if IEN of TIU Files 8925 or 8925.1 is of a certain Doc Class
+2 ;MAGRY = Return String
+3 ; for Success "1^message"
+4 ; for Failure "0^message"
+5 ;IEN = Internal Entry Number in the TIUFILE
+6 ;TIUFILE = either 8925 if we need to see if a Note is of a Document Class
+7 ; or 8925.1 if we need to see if a Title is of a Document Class
+8 ;CLASS = Text Name of the Document Class example: "ADVANCE DIRECTIVE"
+9 ;
+10 SET MAGRY="0^Unknown Error checking TIU Document Class"
+11 KILL MAGTRGT,DEFIEN,DOCCL,RES,DONE,NTTL
+12 SET DONE=0
+13 ; If we're resolving a Title
+14 IF TIUFILE="8925.1"
Begin DoDot:1
+15 SET DEFIEN=IEN
SET NTTL="Title"
+16 IF '$DATA(^TIU(8925.1,DEFIEN,0))
SET MAGRY="0^Invalid Title IEN"
SET DONE=1
QUIT
+17 QUIT
End DoDot:1
if DONE
QUIT
+18 ; If we're resolving a Note
+19 IF TIUFILE="8925"
Begin DoDot:1
+20 SET NTTL="Note"
+21 IF '$DATA(^TIU(8925,IEN))
SET MAGRY="0^Invalid Note IEN"
SET DONE=1
QUIT
+22 ; Get Title IEN from Note IEN
+23 SET DEFIEN=$$GET1^DIQ(8925,IEN_",",.01,"I")
+24 IF DEFIEN=""
SET MAGRY="0^Error resolving Document Class from Note IEN"
SET DONE=1
QUIT
+25 QUIT
End DoDot:1
if DONE
QUIT
+26 ;
+27 ; Find the IEN in 8925.1 for Document Class (CLASS)
+28 DO FIND^DIC(8925.1,"","@;.001","X",CLASS,"","","I $P(^(0),U,4)=""DC""","","MAGTRGT")
+29 SET DOCCL=$GET(MAGTRGT("DILIST",2,1))
+30 ;
+31 ; See if ^TIU(8925.1,DEFIEN is of Document Class DOCCL
+32 SET RES=$$ISA^TIULX(DEFIEN,DOCCL)
+33 IF RES
SET MAGRY="1^The "_NTTL_" is of Document Class "_CLASS
QUIT
+34 SET MAGRY="0^The "_NTTL_" is Not of Document Class "_CLASS
+35 QUIT
+36 ;
+37 ; *******************
+38 ; Patch 108
+39 ; Create a new TIU stub using data in ^MAG(2006.82 by Tracking ID
+40 ; In this way BP doesn't need to be recompiled
+41 ;
+42 ; Return Values
+43 ; =============
+44 ; 0 for failure
+45 ; 1 for success
+46 ;
+47 ; MAGRY
+48 ; for failure "0^message"
+49 ; for success "TIU Note IEN^message"
+50 ; TIUDA - TIU Note IEN
+51 ;
+52 ; Input Parameters
+53 ; ================
+54 ; MAGDA - Image IEN in file #2005
+55 ;
SETTIUDA(MAGRY,MAGDA,TIUDA) ;
+1 NEW TRKID,TIUTTL,TIUTCNT
+2 NEW MAGTEXT,MAGDFN,MAGADCL,MAGMODE,MAGES,MAGESBY,MAGDATE
+3 NEW MAGIAPI,TIUIEN
+4 ; Tracking ID - it is unique
SET TRKID=$$GET1^DIQ(2005,MAGDA,"108")
+5 IF TRKID=""
SET MAGRY="0^TIUDA equals zero and Tracking ID is not found."
QUIT 0
+6 ; Get import data
+7 DO GETIAPID^MAGGSIUI(.MAGIAPI,TRKID)
+8 ; no data quit
IF '$DATA(MAGIAPI)
SET MAGRY="0^TIUDA equals zero and no data found by Tracking ID."
QUIT 0
+9 ; Get TIU Title
SET TIUTTL=$GET(MAGIAPI("PXTIUTTL"))
+10 ; Validate TIU Title
+11 IF '$$GETTIUDA^MAGGSIV(.MAGRY,TIUTTL,.TIUIEN)
QUIT 0
+12 ; set TIUTTL to internal TIU Title in case the external value is provided
SET TIUTTL=TIUIEN
+13 ; Get Text
+14 ; TIU note Text Lines Count
SET TIUTCNT=+$GET(MAGIAPI("PXTIUTCNT"))
+15 FOR I=0:1:TIUTCNT-1
Begin DoDot:1
+16 ; Get Text Lines
SET MAGTEXT(I)=$GET(MAGIAPI("PXTIUTXT"_$TRANSLATE($JUSTIFY(I,5)," ",0)))
+17 QUIT
End DoDot:1
+18 SET MAGTEXT(TIUTCNT)=" VistA Imaging Import API - Imported Document"
+19 ; Patient DFN
SET MAGDFN=$$GET1^DIQ(2005,MAGDA,"5","I")
+20 ; Signature Type - 0 unsigned/ 1 Admin closed/ 2 Signed
SET MAGADCL=+$GET(MAGIAPI("PXSGNTYP"))
+21 SET MAGMODE="E"
+22 SET MAGES=""
+23 ; Image Capture by ( Signed)
SET MAGESBY=$$GET1^DIQ(2005,MAGDA,"8","I")
+24 ; TIU note Date
SET MAGDATE=$GET(MAGIAPI("PXDT"))
+25 ; Create a new TIU note
+26 DO NEW^MAGGNTI1(.MAGRY,MAGDFN,TIUTTL,MAGADCL,MAGMODE,MAGES,MAGESBY,"",MAGDATE,"",.MAGTEXT)
+27 IF $PIECE(MAGRY,"^")
SET TIUDA=+MAGRY
DO UPDPKG^MAGGNTI(MAGDA,TIUDA)
QUIT 1
+28 QUIT 0
+29 ;
+30 ; *******************
+31 ; Patch 108
+32 ; Update Package Index (#40) in #2005 based on TIU Note info.
+33 ;
+34 ; Input Parameters
+35 ; ================
+36 ; MAGDA - Image IEN in file #2005
+37 ; PXIEN - TIU Note IEN in file #8925
+38 ;
UPDPKG(MAGDA,PXIEN) ;Patch 108: Update Package Index (#40) in #2005 based on TIU Note info.
+1 NEW PKG,MAGRY,OK,MAGGFDA,MAGGXE,MAGNOFMAUDIT
+2 SET PKG=$$GET1^DIQ(2005,MAGDA_",",40)
+3 ; Quit if the package is already set to something else than "NONE"
IF PKG'="NONE"
QUIT
+4 SET PKG=""
+5 DO DATA^MAGGNTI(.MAGRY,PXIEN)
+6 DO ISCP^TIUCP(.OK,$PIECE(MAGRY,U,2))
IF OK
SET PKG="CP"
+7 IF PKG=""
DO ISCNSLT^TIUCNSLT(.OK,$PIECE(MAGRY,U,2))
IF OK
SET PKG="CONS"
+8 IF PKG=""
SET PKG="NOTE"
+9 SET MAGGFDA(2005,MAGDA_",",40)=PKG
+10 ; Do not file the changes in Audit file.
SET MAGNOFMAUDIT=1
+11 ; We are not done with initial setup
+12 DO UPDATE^DIE("","MAGGFDA","","MAGGXE")
+13 QUIT
