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

MAGGSIU2.m

Go to the documentation of this file.
  1. MAGGSIU2 ;WOIFO/GEK/NST - Utilities for Image Add/Modify ; 20 May 2010 1:42 PM
  1. ;;3.0;IMAGING;**7,8,85,59,108**;Mar 19, 2002;Build 1738;May 20, 2010
  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. MAKEFDA(MAGGFDA,MAGARRAY,MAGACT,MAGCHLD,MAGGRP,MAGGWP) ;
  1. ; Create the FileMan FDA Array
  1. ; Create Imaging Action Codes Array (for Pre and Post processing)
  1. N MAGGFLD,MAGGDAT,GRPCT,WPCT,Z
  1. S Z="" F S Z=$O(MAGARRAY(Z)) Q:Z="" D I $L(MAGERR) Q
  1. . S MAGGFLD=$P(MAGARRAY(Z),U,1),MAGGDAT=$P(MAGARRAY(Z),U,2,99)
  1. . ; If this entry is one of the action codes, store it in the action array.
  1. . I $$ACTCODE^MAGGSIV(MAGGFLD) S MAGACT(MAGGFLD)=MAGGDAT Q
  1. . ;
  1. . ; If we are Creating a Group Entry, add any Images that are to be members of this group.
  1. . I MAGGFLD=2005.04 D Q
  1. . . S MAGGRP=1
  1. . . I '+MAGGDAT Q ; making a group entry, with no group entries yet. This is OK.
  1. . . S MAGCHLD(MAGGDAT)=""
  1. . . S GRPCT=GRPCT+1
  1. . . S MAGGFDA(2005.04,"+"_GRPCT_",+1,",.01)=MAGGDAT
  1. . ;
  1. . ; if we are getting a WP for Long Desc, set array to pass.
  1. . I MAGGFLD=11 D ; this is one line of the WP Long Desc field.
  1. . . S WPCT=WPCT+1,MAGGWP(WPCT)=MAGGDAT
  1. . . S MAGGFDA(2005,"+1,",11)="MAGGWP"
  1. . ; Set the Node for the UPDATE^DIC Call.
  1. . S MAGGFDA(2005,"+1,",MAGGFLD)=MAGGDAT
  1. . Q
  1. ; Patch 8. Special processing for field 107 (ACQUISITION DEVICE)
  1. ; We'll change any MAGGFDA(2005,"+1,",107) to MAGACT("ACQD")
  1. ; This way the PRE processing of the array will check and create a new
  1. ; ACQUISITION DEVICE file entry, if needed.
  1. I $D(MAGACT("107")) S MAGACT("ACQD")=MAGACT("107") K MAGACT("107")
  1. I $D(MAGGFDA(2005,"+1,",107)) S MAGACT("ACQD")=MAGGFDA(2005,"+1,",107) K MAGGFDA(2005,"+1,",107)
  1. ; Patch 108 - workaround for not compiling BP
  1. ; Since field 17th equals 0 we are going to create a new TIU note
  1. ; when we link the image to a TIU note - FILE^MAGGNTI
  1. ; so kill the 16th and 17th fields data (linked package)
  1. I ($G(MAGGFDA(2005,"+1,",16))="8925"),($G(MAGGFDA(2005,"+1,",17))="0") D
  1. . K MAGGFDA(2005,"+1,",16)
  1. . K MAGGFDA(2005,"+1,",17)
  1. Q
  1. REQPARAM() ;Do required parameters have values. Called from MAGGSIUI
  1. ; VARIABLES ARE SET AND KILLED IN THAT ROUTINE.
  1. N CT,MAGOUT,TXT
  1. S CT=0
  1. S MAGRY(0)="1^Checking for Required parameter values..."
  1. I IDFN="" S CT=CT+1,MAGRY(CT)="DFN is Required. !"
  1. I '$D(IMAGES),'CMTH S CT=CT+1,MAGRY(CT)="List of Images is Required. !"
  1. ;
  1. I (PXPKG=""),(DOCCTG=""),(IXTYPE="") S CT=CT+1,MAGRY(CT)="Procedure or Category or Index Type is Required. !"
  1. I (PXPKG'=""),(DOCCTG'="") S CT=CT+1,MAGRY(CT)="Procedure OR Document Category. Not BOTH. !"
  1. ;
  1. I (PXPKG'=""),(PXIEN=""),(PXNEW'=1) S CT=CT+1,MAGRY(CT)="Procedure IEN is Required. !"
  1. I (PXPKG=""),(PXIEN'="") S CT=CT+1,MAGRY(CT)="Procedure Package is Required. !"
  1. I (PXPKG'=""),(PXDT="") S CT=CT+1,MAGRY(CT)="Procedure Date is Required. !"
  1. ; Patch 108
  1. I (PXNEW=1),(PXPKG'=8925),(PXPKG'="TIU") S CT=CT+1,MAGRY(CT)="Only creating a new TIU note is implemented! PXPKG = 8925 or TIU"
  1. I (PXNEW=1),(PXIEN>0) S CT=CT+1,MAGRY(CT)="Procedure IEN or Procedure New. Not BOTH!"
  1. I ((PXNEW=0)!(PXNEW="")) D
  1. . I PXSGNTYP'="" S CT=CT+1,MAGRY(CT)="Signature Type is not allowed with existing Package!"
  1. . I PXTIUTTL'="" S CT=CT+1,MAGRY(CT)="TIU Title is not allowed with existing Package!"
  1. . Q
  1. I (PXPKG="TIU")!(PXPKG=8925) D
  1. . I (PXNEW=1),(PXSGNTYP'=0),(PXSGNTYP'=1) S CT=CT+1,MAGRY(CT)="Signature Type Unsigned (0) or Electronically Filed (1) Only!"
  1. . I (PXNEW=1),(PXTIUTTL="") S CT=CT+1,MAGRY(CT)="TIU Title is Required!"
  1. . D ADTTLOK^MAGGSIU2(.MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE) ; DOCCTG is blank
  1. . I 'MAGOUT S CT=CT+1,MAGRY(CT)="TIU ADVANCE DIRECTIVE check: "_$P(MAGOUT,U,2)
  1. . Q
  1. ; If we don't link the image then Type Index cannot be ADVANCE DIRECTIVE
  1. I (PXPKG'="TIU"),(PXPKG'=8925) D
  1. . S TXT=$$TYPIXTXT^MAGGSIU2(IXTYPE,DOCCTG) ; Get Type Index text value
  1. . I TXT="ADVANCE DIRECTIVE" S CT=CT+1,MAGRY(CT)="ADVANCE DIRECTIVE Type Index is not allowed"
  1. . Q
  1. ;
  1. ;Patch 8 index field check... could be using Patch 7 or Patch 8.
  1. ; We're this far, so either PXIEN or DOCCTG is defined
  1. I (IXTYPE'=""),(DOCCTG'="") S CT=CT+1,MAGRY(CT)="Image Type OR Document Category. Not BOTH. !"
  1. ; MAGGSIA computes PACKAGE #40 and CLASS #41 when adding an Image (2005) entry.
  1. ;
  1. I TRKID="" S CT=CT+1,MAGRY(CT)="Tracking ID is Required. !"
  1. I ACQD="" S CT=CT+1,MAGRY(CT)="Acquisition Device is Required. !"
  1. ; ACQS ( could ? ) default to users institution i.e. DUZ(2)
  1. I (ACQS="")&(ACQN="") S CT=CT+1,MAGRY(CT)="Acquisition Site IEN or Station Number is Required. !"
  1. I (ACQS]"")&(ACQN]"") S CT=CT+1,MAGRY(CT)="Station IEN or Station Number, Not BOTH. !"
  1. ;
  1. I STSCB="" S CT=CT+1,MAGRY(CT)="Status Handler (TAG^ROUTINE) is Required. !"
  1. ;
  1. I (DOCCTG'=""),(DOCDT="") S CT=CT+1,MAGRY(CT)="Document Date is Required. !"
  1. ;
  1. I (CT>0) S MAGRY(0)="0^Required parameter is null" Q MAGRY(0)
  1. ;Checks to stop Duplicate or incorrect Tracking ID's
  1. ; //TODO: ?? check the Queue File, is this Tracking ID already Queued.
  1. I (TRKID'="") I $D(^MAG(2005,"ATRKID",TRKID)) S MAGRY(0)="0^Tracking ID Must be Unique !"
  1. I (TRKID'="") I ($L(TRKID,";")<2) S MAGRY(0)="0^Tracking ID Must have "";"" Delimiter"
  1. ;
  1. Q MAGRY(0)
  1. ;
  1. ;***** We are forcing any IMAGE that has INDEX TYPE = ADVANCE DIRECTIVE
  1. ; to be associated with a Progress Note of Doc Class ADVANCE DIRECTIVE
  1. ; And any Note that is an ADVANCE DIRECTIVE to have an INDEX TYPE of ADVANCE DIRECTIVE
  1. ;
  1. ; Input Parameters
  1. ; ================
  1. ; PXNEW - Flag if we are creating a new TIU Note 1- YES, 0 - NO
  1. ; PXIEN - Existing TIU Note (IEN in file #8925)
  1. ; PXTIUTTL - TIU Title in file #8925.1 - Could be Integer (IEN) or text
  1. ; IXTYPE - Image Index Type IEN or Text - file #2005.83
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; if check did not passed
  1. ; MAGOUT = "0^Error message"
  1. ; if check passed
  1. ; MAGOUT = "1"
  1. ;
  1. ADTTLOK(MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE) ;
  1. ; if index type is not set for existing note don't check for advance directive
  1. I (PXNEW'=1),(IXTYPE="") S MAGOUT=1 Q
  1. ;
  1. N TIEN,ADVTITLE,TYPETXT
  1. I PXNEW=1 D Q:'MAGOUT
  1. . S TIEN=""
  1. . I '$$GETTIUDA^MAGGSIV(.MAGOUT,PXTIUTTL,.TIEN) Q
  1. . D ISDOCCL^MAGGNTI(.ADVTITLE,+TIEN,8925.1,"ADVANCE DIRECTIVE")
  1. . Q
  1. I PXNEW'=1 D
  1. . D ISDOCCL^MAGGNTI(.ADVTITLE,+PXIEN,8925,"ADVANCE DIRECTIVE")
  1. . Q
  1. ; Get Index Type Text
  1. S TYPETXT=$S(IXTYPE?1.N:$$GET1^DIQ(2005.83,IXTYPE_",",.01),1:IXTYPE)
  1. ;
  1. I +ADVTITLE D Q ; Index Type must be ADVANCE DIRECTIVE
  1. . I TYPETXT="ADVANCE DIRECTIVE" S MAGOUT=1 Q
  1. . S MAGOUT="0^Index Type must be ADVANCE DIRECTIVE" Q
  1. . Q
  1. ; TIU Title is not ADVANCE DIRECTIVE - Check the index
  1. I TYPETXT="ADVANCE DIRECTIVE" D Q
  1. . I (PXIEN'="")!(PXTIUTTL'="") S MAGOUT="0^TIU Note must be ADVANCE DIRECTIVE" Q
  1. . S MAGOUT="0^ADVANCE DIRECTIVE Type Index is not allowed"
  1. . Q
  1. ;
  1. S MAGOUT=1 ; Image Type Index is not ADVANCE DIRECTIVE
  1. Q
  1. ;
  1. ; IXTYPE - Type Index - IEN or text
  1. ; DOCCTG - Document Category IEN or text
  1. TYPIXTXT(IXTYPE,DOCCTG) ; Get Type Index Text
  1. N MAGR
  1. I IXTYPE?1.N Q $$GET1^DIQ(2005.83,IXTYPE_",",.01)
  1. I IXTYPE="",DOCCTG="" Q ""
  1. I DOCCTG?1.N Q $$GET1^DIQ(2005.81,DOCCTG_",",42) ; return external value of field 42
  1. D CHK^DIE(2005,100,"E",DOCCTG,.MAGR,"MAGMSG")
  1. I MAGR="^" Q ""
  1. Q $$GET1^DIQ(2005.81,MAGR_",",42) ; return external value of field 42