MAGGSIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; 01 Nov 2010 2:08 PM
;;3.0;IMAGING;**7,8,85,59,93,106,117,121**;Mar 19, 2002;Build 2340;Oct 20, 2011
;; 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
PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ;
; Check on some possible problems: required fields etc.
; Object Type and (Patient, or Short Desc) Required.
N MAGRSLT,X,Z
; Patch 106: PRE^MAGGSIA1 is called by Import API only so
; if CAPTURE APPLICATION field (#8.1) is not set we set it to "I"
; For VI Capture and DICOM Gateway the value of #8.1 is set
; in ADD^MAGGTIA
I '$D(MAGGFDA(2005,"+1,",8.1)) S MAGGFDA(2005,"+1,",8.1)="I"
;
D CHKRSND ; Check if this is a Rescinded Import.
S:$G(MAGGFDA(2005,"+1,",113))="" MAGGFDA(2005,"+1,",113)=1 ; Patch 117 Set STATUS (#113) to Viewable (1)
I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE
I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q
I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D Q
. S MAGERR="0^Need Patient or Short Desc. Operation CANCELED "
; IF no Procedure text we'll give it some so crossref will set.
D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q
; Patch 8 IAPI We Create IXCLS (#41 CLASS) and IXPKG (#40 Package) if TYPE is in Data.
; But we are not making TYPE required yet for backward compatibility.
I $D(MAGGFDA(2005,"+1,",42)) D
. I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D S MAGRY=MAGERR Q
. . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE"
. I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
. I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D S MAGRY=MAGERR Q
. . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image."
. I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
. I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
. I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
. Q
;
I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT
;
; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW
I '$D(MAGGFDA(2005,"+1,",15)) D
. I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q
. S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12)
; DateTime image saved.
I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12)
; Short Description
;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6))
; Name (.01)
I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ)
; Acquisition Site, Use it to tell where to save the file.
I $D(MAGACT("ACQS")) D
. ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05
. I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";")
; Only get drive:dir if not a group
I 'MAGGRP D I $L(MAGERR) Q
. ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location
. ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code)
. S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
. ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = ""
. ;
. S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write
. I 'Z S MAGERR=Z Q
. S MAGGDRV=$P(Z,U,2)
. S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic
. ; if a big file is being made on workstation, put NetWork Location
. ; pointer in the BIG NETWORK LOCATION field.
. ; (BIG files default to same Network Location as FullRes (or PACS))
. I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z
. S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1
. I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z
;
I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL")
; HERE we are putting PRE Processing for the Import API action codes.
; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it.
I $D(MAGACT("ACQD")) D
. ; IF Value is a pointer to the ACQ DEVICE File Quit. If it's invalid then UPDATE will catch it.
. I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q
. I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D Q
. . ; IF Already exists, add it to the FDA
. . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),""))
. . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ?
. . ; ??
. ; IF it doesn't exist, create it, and add it's ien to the image entry
. N MAGDFDA,MAGDIEN,MAGDXE
. S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD")
. S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05)))
. S MAGDFDA(2006.04,"+1,",2)=$S($D(MAGACT("ACQL")):MAGACT("ACQL"),$D(MAGGFDA(2005,"+1,",101)):MAGGFDA(2005,"+1,",101),1:$P($G(MAGACT("ACQS")),";",2))
. ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece
. ; now it is sent as it's own value in ACQL
. D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE")
. S MAGGFDA(2005,"+1,",107)=MAGDIEN(1)
;~~~ Delete this comment and the following line of code when
; the IMAGE AUDIT file (#2005.1) is completely eliminated.
; If the last IEN in the IMAGE AUDIT file is greater than the
;~~~ last IEN in the IMAGE file, update the IMAGE file header.
I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
;
Q
PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient
;
N MAGDFN,PX,PXDA,MAGY
S PX=$G(MAGGFDA(2005,"+1,",16))
S PXDA=$G(MAGGFDA(2005,"+1,",17))
I 'PX S MAGR=1 Q ; This is a category, or an Image of a group (no parent pointer)
S MAGDFN=MAGGFDA(2005,"+1,",5)
I (PX=8925) D Q
. I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q
. D DATA^MAGGNTI(.MAGY,PXDA)
. I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q
. S MAGR=1
Q
OBJTYPE ; This call uses the EXT and computes an Object Type
N MTYPE
I '$L($G(MAGACT("EXT"))) Q
S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),""))
;I 'MTYPE Q
;TODO : Answer question, do we want to have a default Image type ?
I 'MTYPE S MTYPE=1
S MAGGFDA(2005,"+1,",3)=MTYPE
Q
ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type
N CL
I '$G(TYPE) Q 0
S CL=$$GET1^DIQ(2005.83,TYPE,1,"E")
Q $S($E(CL,1,5)="ADMIN":1,1:0)
PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F]
; We are here because fld #6 PROCEDURE [8F] is null.
; If a pointer to a package is in the data, (flds 16 and 17)
; get fld #6 from that , if not then treat it as an UNASSIGNED image
; i.e. Category UNASSIGNED.
N MAGYPX,PARENT,PARIEN,PXDESC
S PARENT=$G(MAGGFDA(2005,"+1,",16))
S PARIEN=$G(MAGGFDA(2005,"+1,",17))
;
I (PARENT=8925),(PARIEN]"") D Q
. D DATA^MAGGNTI(.MAGYPX,PARIEN)
. S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2)
;TODO; create calls to get default procedure desc for all specialties
; AND default to NONE if a TYPE and no PARENT data File (fld 16)
; If a Parent pointer exists, and it isn't TIU, for now set "NO Description"
I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q
;
; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY
I ($G(MAGGFDA(2005,"+1,",100))]"") D Q
. S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1)
;
; If a new child of a Group, use that Proc Desc
I $G(MAGGFDA(2005,"+1,",14))]"" D Q
. S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8)
;
; Parent="", and no Category pointer, then we Call it UNASSIGNED
S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED",""))
S MAGGFDA(2005,"+1,",6)="UNASSIGNED"
Q
; ---------- CHKRSND ----------
; Import API Delphi Component/OCX only allows certain fields. To get
; around that limitation, we sometimes need to get data from the
; IMAGING WINDOWS SESSION File. (#2006.82)
;
; Here we add data to MAGGFDA from fields in Session file
; that didn't make it thought the Delphi Component/OCX
CHKRSND ;
N IDATA,TRKID
S TRKID=$G(MAGGFDA(2005,"+1,",108)) Q:'$L(TRKID)
D GETIAPID^MAGGSIUI(.IDATA,TRKID)
;
; PROCEDURE #6
; CREATION DATE #110
; LINKED IMAGE #115.1
; LINKED TYPE #115.2
; LINKED DATE #115.3 (DATE TIME)
;
; Here we can add other fields to MAGGFDA, that aren't passed through
; the delphi control, but are stored in the Session file for the Import.
; If not rescind action, then QUIT
I $G(IDATA("ACTION"))'="RESCIND" Q
; get the LINKED IMAGE and associated fields #115*
; All data was already validated before added to session file.
I $G(IDATA(6))'="" S MAGGFDA(2005,"+1,",6)=$G(IDATA(6))
I $G(IDATA(110))'="" S MAGGFDA(2005,"+1,",110)=$G(IDATA(110))
I $G(IDATA(115.1))'="" S MAGGFDA(2005,"+1,",115.1)=$G(IDATA(115.1))
I $G(IDATA(115.2))'="" S MAGGFDA(2005,"+1,",115.2)=$G(IDATA(115.2))
I $G(IDATA(115.3))'="" S MAGGFDA(2005,"+1,",115.3)=$G(IDATA(115.3))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIA1 10249 printed Apr 09, 2024@21:08:20 Page 2
MAGGSIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; 01 Nov 2010 2:08 PM
+1 ;;3.0;IMAGING;**7,8,85,59,93,106,117,121**;Mar 19, 2002;Build 2340;Oct 20, 2011
+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
PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ;
+1 ; Check on some possible problems: required fields etc.
+2 ; Object Type and (Patient, or Short Desc) Required.
+3 NEW MAGRSLT,X,Z
+4 ; Patch 106: PRE^MAGGSIA1 is called by Import API only so
+5 ; if CAPTURE APPLICATION field (#8.1) is not set we set it to "I"
+6 ; For VI Capture and DICOM Gateway the value of #8.1 is set
+7 ; in ADD^MAGGTIA
+8 IF '$DATA(MAGGFDA(2005,"+1,",8.1))
SET MAGGFDA(2005,"+1,",8.1)="I"
+9 ;
+10 ; Check if this is a Rescinded Import.
DO CHKRSND
+11 ; Patch 117 Set STATUS (#113) to Viewable (1)
if $GET(MAGGFDA(2005,"+1,",113))=""
SET MAGGFDA(2005,"+1,",113)=1
+12 IF '$DATA(MAGGFDA(2005,"+1,",3))
DO OBJTYPE
+13 IF '$DATA(MAGGFDA(2005,"+1,",3))
SET MAGERR="0^Need an Object Type "
QUIT
+14 IF '$DATA(MAGGFDA(2005,"+1,",5))
IF '$DATA(MAGGFDA(2005,"+1,",10))
Begin DoDot:1
+15 SET MAGERR="0^Need Patient or Short Desc. Operation CANCELED "
End DoDot:1
QUIT
+16 ; IF no Procedure text we'll give it some so crossref will set.
+17 DO PATCHK(.MAGRSLT)
IF 'MAGRSLT
SET MAGERR=MAGRSLT
QUIT
+18 ; Patch 8 IAPI We Create IXCLS (#41 CLASS) and IXPKG (#40 Package) if TYPE is in Data.
+19 ; But we are not making TYPE required yet for backward compatibility.
+20 IF $DATA(MAGGFDA(2005,"+1,",42))
Begin DoDot:1
+21 IF $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE"
Begin DoDot:2
+22 SET MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE"
End DoDot:2
SET MAGRY=MAGERR
QUIT
+23 IF '$DATA(MAGGFDA(2005,"+1,",41))
DO MAKECLAS^MAGGSIU1
IF $LENGTH(MAGERR)
SET MAGRY=MAGERR
QUIT
+24 IF ($DATA(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42)))
Begin DoDot:2
+25 SET MAGERR="0^Can't have an ADMIN TYPE with Clinical Image."
End DoDot:2
SET MAGRY=MAGERR
QUIT
+26 IF '$DATA(MAGGFDA(2005,"+1,",40))
DO MAKEPKG^MAGGSIU1
IF $LENGTH(MAGERR)
SET MAGRY=MAGERR
QUIT
+27 IF '$DATA(MAGGFDA(2005,"+1,",6))
DO MAKEPROC^MAGGSIU1
IF $LENGTH(MAGERR)
SET MAGRY=MAGERR
QUIT
+28 IF '$DATA(MAGGFDA(2005,"+1,",45))
DO MAKEORIG^MAGGSIU1
IF $LENGTH(MAGERR)
SET MAGRY=MAGERR
QUIT
+29 QUIT
End DoDot:1
+30 ;
+31 IF '$DATA(MAGGFDA(2005,"+1,",6))
DO PROCTEXT
+32 ;
+33 ; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW
+34 IF '$DATA(MAGGFDA(2005,"+1,",15))
Begin DoDot:1
+35 IF $DATA(MAGGFDA(2005,"+1,",110))
SET MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110)
QUIT
+36 SET MAGGFDA(2005,"+1,",15)=$EXTRACT($$NOW^XLFDT,1,12)
End DoDot:1
+37 ; DateTime image saved.
+38 IF '$DATA(MAGGFDA(2005,"+1,",7))
SET MAGGFDA(2005,"+1,",7)=$EXTRACT($$NOW^XLFDT,1,12)
+39 ; Short Description
+40 ;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
+41 IF '$DATA(MAGGFDA(2005,"+1,",10))
SET MAGGFDA(2005,"+1,",10)=$GET(MAGGFDA(2005,"+1,",6))
+42 ; Name (.01)
+43 IF '$DATA(MAGGFDA(2005,"+1,",.01))
SET MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
+44 IF '$DATA(MAGGFDA(2005,"+1,",8))
SET MAGGFDA(2005,"+1,",8)=$GET(DUZ)
+45 ; Acquisition Site, Use it to tell where to save the file.
+46 IF $DATA(MAGACT("ACQS"))
Begin DoDot:1
+47 ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05
+48 IF $PIECE(MAGACT("ACQS"),";")]""
SET MAGGFDA(2005,"+1,",.05)=$PIECE(MAGACT("ACQS"),";")
End DoDot:1
+49 ; Only get drive:dir if not a group
+50 IF 'MAGGRP
Begin DoDot:1
+51 ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location
+52 ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code)
+53 SET X=$SELECT($DATA(MAGACT("WRITE")):MAGACT("WRITE"),$DATA(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
+54 ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = ""
+55 ;
+56 ;Drv:Dir to Write
SET Z=$$DRIVE^MAGGTU1(X,$GET(MAGGFDA(2005,"+1,",.05)))
+57 IF 'Z
SET MAGERR=Z
QUIT
+58 SET MAGGDRV=$PIECE(Z,U,2)
+59 ;Disk & Vol magnetic
SET MAGGFDA(2005,"+1,",2)=+Z
+60 ; if a big file is being made on workstation, put NetWork Location
+61 ; pointer in the BIG NETWORK LOCATION field.
+62 ; (BIG files default to same Network Location as FullRes (or PACS))
+63 IF $GET(MAGACT("BIG"))=1
SET MAGGFDA(2005,"+1,",102)=+Z
+64 ; save network location ien for $$DIRHASH in ^MAGGSIA1
SET MAGREF=+Z
+65 IF $GET(MAGACT("ABS"))="STUFFONLY"
SET MAGGFDA(2005,"+1,",2.1)=+Z
End DoDot:1
IF $LENGTH(MAGERR)
QUIT
+66 ;
+67 IF $DATA(MAGACT("ACQL"))
SET MAGGFDA(2005,"+1,",101)=MAGACT("ACQL")
+68 ; HERE we are putting PRE Processing for the Import API action codes.
+69 ; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it.
+70 IF $DATA(MAGACT("ACQD"))
Begin DoDot:1
+71 ; IF Value is a pointer to the ACQ DEVICE File Quit. If it's invalid then UPDATE will catch it.
+72 IF (+MAGACT("ACQD")=MAGACT("ACQD"))
SET MAGGFDA(2005,"+1,",107)=MAGACT("ACQD")
QUIT
+73 IF $DATA(^MAG(2006.04,"B",MAGACT("ACQD")))
Begin DoDot:2
+74 ; IF Already exists, add it to the FDA
+75 SET MAGGFDA(2005,"+1,",107)=$ORDER(^MAG(2006.04,"B",MAGACT("ACQD"),""))
+76 ; What do we do with the Acquisition Site. IF Acq Dev already exists. ?
+77 ; ??
End DoDot:2
QUIT
+78 ; IF it doesn't exist, create it, and add it's ien to the image entry
+79 NEW MAGDFDA,MAGDIEN,MAGDXE
+80 SET MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD")
+81 SET MAGDFDA(2006.04,"+1,",1)=$SELECT($DATA(MAGACT("ACQS")):$PIECE(MAGACT("ACQS"),";"),1:$GET(MAGGFDA(2005,"+1,",.05)))
+82 SET MAGDFDA(2006.04,"+1,",2)=$SELECT($DATA(MAGACT("ACQL")):MAGACT("ACQL"),$DATA(MAGGFDA(2005,"+1,",101)):MAGGFDA(2005,"+1,",101),1:$PIECE($GET(MAGACT("ACQS")),";",2))
+83 ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece
+84 ; now it is sent as it's own value in ACQL
+85 DO UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE")
+86 SET MAGGFDA(2005,"+1,",107)=MAGDIEN(1)
End DoDot:1
+87 ;~~~ Delete this comment and the following line of code when
+88 ; the IMAGE AUDIT file (#2005.1) is completely eliminated.
+89 ; If the last IEN in the IMAGE AUDIT file is greater than the
+90 ;~~~ last IEN in the IMAGE file, update the IMAGE file header.
+91 IF ($ORDER(^MAG(2005,"A"),-1)<$ORDER(^MAG(2005.1,"A"),-1))
SET $PIECE(^MAG(2005,0),U,3)=$ORDER(^MAG(2005.1,"A"),-1)
+92 ;
+93 QUIT
PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient
+1 ;
+2 NEW MAGDFN,PX,PXDA,MAGY
+3 SET PX=$GET(MAGGFDA(2005,"+1,",16))
+4 SET PXDA=$GET(MAGGFDA(2005,"+1,",17))
+5 ; This is a category, or an Image of a group (no parent pointer)
IF 'PX
SET MAGR=1
QUIT
+6 SET MAGDFN=MAGGFDA(2005,"+1,",5)
+7 IF (PX=8925)
Begin DoDot:1
+8 IF '$DATA(^TIU(8925,PXDA))
SET MAGR="0^Invalid TIU Entry Number: "_PXDA
QUIT
+9 DO DATA^MAGGNTI(.MAGY,PXDA)
+10 IF '(MAGDFN=$PIECE(MAGY,U,4))
SET MAGR="0^Procedure and Imaging patients don't match."
QUIT
+11 SET MAGR=1
End DoDot:1
QUIT
+12 QUIT
OBJTYPE ; This call uses the EXT and computes an Object Type
+1 NEW MTYPE
+2 IF '$LENGTH($GET(MAGACT("EXT")))
QUIT
+3 SET MTYPE=$ORDER(^MAG(2005.02,"AD",MAGACT("EXT"),""))
+4 ;I 'MTYPE Q
+5 ;TODO : Answer question, do we want to have a default Image type ?
+6 IF 'MTYPE
SET MTYPE=1
+7 SET MAGGFDA(2005,"+1,",3)=MTYPE
+8 QUIT
ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type
+1 NEW CL
+2 IF '$GET(TYPE)
QUIT 0
+3 SET CL=$$GET1^DIQ(2005.83,TYPE,1,"E")
+4 QUIT $SELECT($EXTRACT(CL,1,5)="ADMIN":1,1:0)
PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F]
+1 ; We are here because fld #6 PROCEDURE [8F] is null.
+2 ; If a pointer to a package is in the data, (flds 16 and 17)
+3 ; get fld #6 from that , if not then treat it as an UNASSIGNED image
+4 ; i.e. Category UNASSIGNED.
+5 NEW MAGYPX,PARENT,PARIEN,PXDESC
+6 SET PARENT=$GET(MAGGFDA(2005,"+1,",16))
+7 SET PARIEN=$GET(MAGGFDA(2005,"+1,",17))
+8 ;
+9 IF (PARENT=8925)
IF (PARIEN]"")
Begin DoDot:1
+10 DO DATA^MAGGNTI(.MAGYPX,PARIEN)
+11 SET MAGGFDA(2005,"+1,",6)=$PIECE(MAGYPX,U,2)
End DoDot:1
QUIT
+12 ;TODO; create calls to get default procedure desc for all specialties
+13 ; AND default to NONE if a TYPE and no PARENT data File (fld 16)
+14 ; If a Parent pointer exists, and it isn't TIU, for now set "NO Description"
+15 IF PARENT]""
SET MAGGFDA(2005,"+1,",6)="No Description"
QUIT
+16 ;
+17 ; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY
+18 IF ($GET(MAGGFDA(2005,"+1,",100))]"")
Begin DoDot:1
+19 SET MAGGFDA(2005,"+1,",6)=$PIECE(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1)
End DoDot:1
QUIT
+20 ;
+21 ; If a new child of a Group, use that Proc Desc
+22 IF $GET(MAGGFDA(2005,"+1,",14))]""
Begin DoDot:1
+23 SET MAGGFDA(2005,"+1,",6)=$PIECE(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8)
End DoDot:1
QUIT
+24 ;
+25 ; Parent="", and no Category pointer, then we Call it UNASSIGNED
+26 SET MAGGFDA(2005,"+1,",100)=$ORDER(^MAG(2005.81,"B","UNASSIGNED",""))
+27 SET MAGGFDA(2005,"+1,",6)="UNASSIGNED"
+28 QUIT
+29 ; ---------- CHKRSND ----------
+30 ; Import API Delphi Component/OCX only allows certain fields. To get
+31 ; around that limitation, we sometimes need to get data from the
+32 ; IMAGING WINDOWS SESSION File. (#2006.82)
+33 ;
+34 ; Here we add data to MAGGFDA from fields in Session file
+35 ; that didn't make it thought the Delphi Component/OCX
CHKRSND ;
+1 NEW IDATA,TRKID
+2 SET TRKID=$GET(MAGGFDA(2005,"+1,",108))
if '$LENGTH(TRKID)
QUIT
+3 DO GETIAPID^MAGGSIUI(.IDATA,TRKID)
+4 ;
+5 ; PROCEDURE #6
+6 ; CREATION DATE #110
+7 ; LINKED IMAGE #115.1
+8 ; LINKED TYPE #115.2
+9 ; LINKED DATE #115.3 (DATE TIME)
+10 ;
+11 ; Here we can add other fields to MAGGFDA, that aren't passed through
+12 ; the delphi control, but are stored in the Session file for the Import.
+13 ; If not rescind action, then QUIT
+14 IF $GET(IDATA("ACTION"))'="RESCIND"
QUIT
+15 ; get the LINKED IMAGE and associated fields #115*
+16 ; All data was already validated before added to session file.
+17 IF $GET(IDATA(6))'=""
SET MAGGFDA(2005,"+1,",6)=$GET(IDATA(6))
+18 IF $GET(IDATA(110))'=""
SET MAGGFDA(2005,"+1,",110)=$GET(IDATA(110))
+19 IF $GET(IDATA(115.1))'=""
SET MAGGFDA(2005,"+1,",115.1)=$GET(IDATA(115.1))
+20 IF $GET(IDATA(115.2))'=""
SET MAGGFDA(2005,"+1,",115.2)=$GET(IDATA(115.2))
+21 IF $GET(IDATA(115.3))'=""
SET MAGGFDA(2005,"+1,",115.3)=$GET(IDATA(115.3))
+22 QUIT
