- 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 Jan 18, 2025@03:03:55 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