- 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 Feb 18, 2025@23:28:59 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
