- MAGGSIU2 ;WOIFO/GEK/NST - Utilities for Image Add/Modify ; 20 May 2010 1:42 PM
- ;;3.0;IMAGING;**7,8,85,59,108**;Mar 19, 2002;Build 1738;May 20, 2010
- ;; 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
- MAKEFDA(MAGGFDA,MAGARRAY,MAGACT,MAGCHLD,MAGGRP,MAGGWP) ;
- ; Create the FileMan FDA Array
- ; Create Imaging Action Codes Array (for Pre and Post processing)
- N MAGGFLD,MAGGDAT,GRPCT,WPCT,Z
- S Z="" F S Z=$O(MAGARRAY(Z)) Q:Z="" D I $L(MAGERR) Q
- . S MAGGFLD=$P(MAGARRAY(Z),U,1),MAGGDAT=$P(MAGARRAY(Z),U,2,99)
- . ; If this entry is one of the action codes, store it in the action array.
- . I $$ACTCODE^MAGGSIV(MAGGFLD) S MAGACT(MAGGFLD)=MAGGDAT Q
- . ;
- . ; If we are Creating a Group Entry, add any Images that are to be members of this group.
- . I MAGGFLD=2005.04 D Q
- . . S MAGGRP=1
- . . I '+MAGGDAT Q ; making a group entry, with no group entries yet. This is OK.
- . . S MAGCHLD(MAGGDAT)=""
- . . S GRPCT=GRPCT+1
- . . S MAGGFDA(2005.04,"+"_GRPCT_",+1,",.01)=MAGGDAT
- . ;
- . ; if we are getting a WP for Long Desc, set array to pass.
- . I MAGGFLD=11 D ; this is one line of the WP Long Desc field.
- . . S WPCT=WPCT+1,MAGGWP(WPCT)=MAGGDAT
- . . S MAGGFDA(2005,"+1,",11)="MAGGWP"
- . ; Set the Node for the UPDATE^DIC Call.
- . S MAGGFDA(2005,"+1,",MAGGFLD)=MAGGDAT
- . Q
- ; Patch 8. Special processing for field 107 (ACQUISITION DEVICE)
- ; We'll change any MAGGFDA(2005,"+1,",107) to MAGACT("ACQD")
- ; This way the PRE processing of the array will check and create a new
- ; ACQUISITION DEVICE file entry, if needed.
- I $D(MAGACT("107")) S MAGACT("ACQD")=MAGACT("107") K MAGACT("107")
- I $D(MAGGFDA(2005,"+1,",107)) S MAGACT("ACQD")=MAGGFDA(2005,"+1,",107) K MAGGFDA(2005,"+1,",107)
- ; Patch 108 - workaround for not compiling BP
- ; Since field 17th equals 0 we are going to create a new TIU note
- ; when we link the image to a TIU note - FILE^MAGGNTI
- ; so kill the 16th and 17th fields data (linked package)
- I ($G(MAGGFDA(2005,"+1,",16))="8925"),($G(MAGGFDA(2005,"+1,",17))="0") D
- . K MAGGFDA(2005,"+1,",16)
- . K MAGGFDA(2005,"+1,",17)
- Q
- REQPARAM() ;Do required parameters have values. Called from MAGGSIUI
- ; VARIABLES ARE SET AND KILLED IN THAT ROUTINE.
- N CT,MAGOUT,TXT
- S CT=0
- S MAGRY(0)="1^Checking for Required parameter values..."
- I IDFN="" S CT=CT+1,MAGRY(CT)="DFN is Required. !"
- I '$D(IMAGES),'CMTH S CT=CT+1,MAGRY(CT)="List of Images is Required. !"
- ;
- I (PXPKG=""),(DOCCTG=""),(IXTYPE="") S CT=CT+1,MAGRY(CT)="Procedure or Category or Index Type is Required. !"
- I (PXPKG'=""),(DOCCTG'="") S CT=CT+1,MAGRY(CT)="Procedure OR Document Category. Not BOTH. !"
- ;
- I (PXPKG'=""),(PXIEN=""),(PXNEW'=1) S CT=CT+1,MAGRY(CT)="Procedure IEN is Required. !"
- I (PXPKG=""),(PXIEN'="") S CT=CT+1,MAGRY(CT)="Procedure Package is Required. !"
- I (PXPKG'=""),(PXDT="") S CT=CT+1,MAGRY(CT)="Procedure Date is Required. !"
- ; Patch 108
- 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"
- I (PXNEW=1),(PXIEN>0) S CT=CT+1,MAGRY(CT)="Procedure IEN or Procedure New. Not BOTH!"
- I ((PXNEW=0)!(PXNEW="")) D
- . I PXSGNTYP'="" S CT=CT+1,MAGRY(CT)="Signature Type is not allowed with existing Package!"
- . I PXTIUTTL'="" S CT=CT+1,MAGRY(CT)="TIU Title is not allowed with existing Package!"
- . Q
- I (PXPKG="TIU")!(PXPKG=8925) D
- . I (PXNEW=1),(PXSGNTYP'=0),(PXSGNTYP'=1) S CT=CT+1,MAGRY(CT)="Signature Type Unsigned (0) or Electronically Filed (1) Only!"
- . I (PXNEW=1),(PXTIUTTL="") S CT=CT+1,MAGRY(CT)="TIU Title is Required!"
- . D ADTTLOK^MAGGSIU2(.MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE) ; DOCCTG is blank
- . I 'MAGOUT S CT=CT+1,MAGRY(CT)="TIU ADVANCE DIRECTIVE check: "_$P(MAGOUT,U,2)
- . Q
- ; If we don't link the image then Type Index cannot be ADVANCE DIRECTIVE
- I (PXPKG'="TIU"),(PXPKG'=8925) D
- . S TXT=$$TYPIXTXT^MAGGSIU2(IXTYPE,DOCCTG) ; Get Type Index text value
- . I TXT="ADVANCE DIRECTIVE" S CT=CT+1,MAGRY(CT)="ADVANCE DIRECTIVE Type Index is not allowed"
- . Q
- ;
- ;Patch 8 index field check... could be using Patch 7 or Patch 8.
- ; We're this far, so either PXIEN or DOCCTG is defined
- I (IXTYPE'=""),(DOCCTG'="") S CT=CT+1,MAGRY(CT)="Image Type OR Document Category. Not BOTH. !"
- ; MAGGSIA computes PACKAGE #40 and CLASS #41 when adding an Image (2005) entry.
- ;
- I TRKID="" S CT=CT+1,MAGRY(CT)="Tracking ID is Required. !"
- I ACQD="" S CT=CT+1,MAGRY(CT)="Acquisition Device is Required. !"
- ; ACQS ( could ? ) default to users institution i.e. DUZ(2)
- I (ACQS="")&(ACQN="") S CT=CT+1,MAGRY(CT)="Acquisition Site IEN or Station Number is Required. !"
- I (ACQS]"")&(ACQN]"") S CT=CT+1,MAGRY(CT)="Station IEN or Station Number, Not BOTH. !"
- ;
- I STSCB="" S CT=CT+1,MAGRY(CT)="Status Handler (TAG^ROUTINE) is Required. !"
- ;
- I (DOCCTG'=""),(DOCDT="") S CT=CT+1,MAGRY(CT)="Document Date is Required. !"
- ;
- I (CT>0) S MAGRY(0)="0^Required parameter is null" Q MAGRY(0)
- ;Checks to stop Duplicate or incorrect Tracking ID's
- ; //TODO: ?? check the Queue File, is this Tracking ID already Queued.
- I (TRKID'="") I $D(^MAG(2005,"ATRKID",TRKID)) S MAGRY(0)="0^Tracking ID Must be Unique !"
- I (TRKID'="") I ($L(TRKID,";")<2) S MAGRY(0)="0^Tracking ID Must have "";"" Delimiter"
- ;
- Q MAGRY(0)
- ;
- ;***** We are forcing any IMAGE that has INDEX TYPE = ADVANCE DIRECTIVE
- ; to be associated with a Progress Note of Doc Class ADVANCE DIRECTIVE
- ; And any Note that is an ADVANCE DIRECTIVE to have an INDEX TYPE of ADVANCE DIRECTIVE
- ;
- ; Input Parameters
- ; ================
- ; PXNEW - Flag if we are creating a new TIU Note 1- YES, 0 - NO
- ; PXIEN - Existing TIU Note (IEN in file #8925)
- ; PXTIUTTL - TIU Title in file #8925.1 - Could be Integer (IEN) or text
- ; IXTYPE - Image Index Type IEN or Text - file #2005.83
- ;
- ; Return Values
- ; =============
- ; if check did not passed
- ; MAGOUT = "0^Error message"
- ; if check passed
- ; MAGOUT = "1"
- ;
- ADTTLOK(MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE) ;
- ; if index type is not set for existing note don't check for advance directive
- I (PXNEW'=1),(IXTYPE="") S MAGOUT=1 Q
- ;
- N TIEN,ADVTITLE,TYPETXT
- I PXNEW=1 D Q:'MAGOUT
- . S TIEN=""
- . I '$$GETTIUDA^MAGGSIV(.MAGOUT,PXTIUTTL,.TIEN) Q
- . D ISDOCCL^MAGGNTI(.ADVTITLE,+TIEN,8925.1,"ADVANCE DIRECTIVE")
- . Q
- I PXNEW'=1 D
- . D ISDOCCL^MAGGNTI(.ADVTITLE,+PXIEN,8925,"ADVANCE DIRECTIVE")
- . Q
- ; Get Index Type Text
- S TYPETXT=$S(IXTYPE?1.N:$$GET1^DIQ(2005.83,IXTYPE_",",.01),1:IXTYPE)
- ;
- I +ADVTITLE D Q ; Index Type must be ADVANCE DIRECTIVE
- . I TYPETXT="ADVANCE DIRECTIVE" S MAGOUT=1 Q
- . S MAGOUT="0^Index Type must be ADVANCE DIRECTIVE" Q
- . Q
- ; TIU Title is not ADVANCE DIRECTIVE - Check the index
- I TYPETXT="ADVANCE DIRECTIVE" D Q
- . I (PXIEN'="")!(PXTIUTTL'="") S MAGOUT="0^TIU Note must be ADVANCE DIRECTIVE" Q
- . S MAGOUT="0^ADVANCE DIRECTIVE Type Index is not allowed"
- . Q
- ;
- S MAGOUT=1 ; Image Type Index is not ADVANCE DIRECTIVE
- Q
- ;
- ; IXTYPE - Type Index - IEN or text
- ; DOCCTG - Document Category IEN or text
- TYPIXTXT(IXTYPE,DOCCTG) ; Get Type Index Text
- N MAGR
- I IXTYPE?1.N Q $$GET1^DIQ(2005.83,IXTYPE_",",.01)
- I IXTYPE="",DOCCTG="" Q ""
- I DOCCTG?1.N Q $$GET1^DIQ(2005.81,DOCCTG_",",42) ; return external value of field 42
- D CHK^DIE(2005,100,"E",DOCCTG,.MAGR,"MAGMSG")
- I MAGR="^" Q ""
- Q $$GET1^DIQ(2005.81,MAGR_",",42) ; return external value of field 42
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIU2 8396 printed Jan 18, 2025@03:03:58 Page 2
- 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
- +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
- MAKEFDA(MAGGFDA,MAGARRAY,MAGACT,MAGCHLD,MAGGRP,MAGGWP) ;
- +1 ; Create the FileMan FDA Array
- +2 ; Create Imaging Action Codes Array (for Pre and Post processing)
- +3 NEW MAGGFLD,MAGGDAT,GRPCT,WPCT,Z
- +4 SET Z=""
- FOR
- SET Z=$ORDER(MAGARRAY(Z))
- if Z=""
- QUIT
- Begin DoDot:1
- +5 SET MAGGFLD=$PIECE(MAGARRAY(Z),U,1)
- SET MAGGDAT=$PIECE(MAGARRAY(Z),U,2,99)
- +6 ; If this entry is one of the action codes, store it in the action array.
- +7 IF $$ACTCODE^MAGGSIV(MAGGFLD)
- SET MAGACT(MAGGFLD)=MAGGDAT
- QUIT
- +8 ;
- +9 ; If we are Creating a Group Entry, add any Images that are to be members of this group.
- +10 IF MAGGFLD=2005.04
- Begin DoDot:2
- +11 SET MAGGRP=1
- +12 ; making a group entry, with no group entries yet. This is OK.
- IF '+MAGGDAT
- QUIT
- +13 SET MAGCHLD(MAGGDAT)=""
- +14 SET GRPCT=GRPCT+1
- +15 SET MAGGFDA(2005.04,"+"_GRPCT_",+1,",.01)=MAGGDAT
- End DoDot:2
- QUIT
- +16 ;
- +17 ; if we are getting a WP for Long Desc, set array to pass.
- +18 ; this is one line of the WP Long Desc field.
- IF MAGGFLD=11
- Begin DoDot:2
- +19 SET WPCT=WPCT+1
- SET MAGGWP(WPCT)=MAGGDAT
- +20 SET MAGGFDA(2005,"+1,",11)="MAGGWP"
- End DoDot:2
- +21 ; Set the Node for the UPDATE^DIC Call.
- +22 SET MAGGFDA(2005,"+1,",MAGGFLD)=MAGGDAT
- +23 QUIT
- End DoDot:1
- IF $LENGTH(MAGERR)
- QUIT
- +24 ; Patch 8. Special processing for field 107 (ACQUISITION DEVICE)
- +25 ; We'll change any MAGGFDA(2005,"+1,",107) to MAGACT("ACQD")
- +26 ; This way the PRE processing of the array will check and create a new
- +27 ; ACQUISITION DEVICE file entry, if needed.
- +28 IF $DATA(MAGACT("107"))
- SET MAGACT("ACQD")=MAGACT("107")
- KILL MAGACT("107")
- +29 IF $DATA(MAGGFDA(2005,"+1,",107))
- SET MAGACT("ACQD")=MAGGFDA(2005,"+1,",107)
- KILL MAGGFDA(2005,"+1,",107)
- +30 ; Patch 108 - workaround for not compiling BP
- +31 ; Since field 17th equals 0 we are going to create a new TIU note
- +32 ; when we link the image to a TIU note - FILE^MAGGNTI
- +33 ; so kill the 16th and 17th fields data (linked package)
- +34 IF ($GET(MAGGFDA(2005,"+1,",16))="8925")
- IF ($GET(MAGGFDA(2005,"+1,",17))="0")
- Begin DoDot:1
- +35 KILL MAGGFDA(2005,"+1,",16)
- +36 KILL MAGGFDA(2005,"+1,",17)
- End DoDot:1
- +37 QUIT
- REQPARAM() ;Do required parameters have values. Called from MAGGSIUI
- +1 ; VARIABLES ARE SET AND KILLED IN THAT ROUTINE.
- +2 NEW CT,MAGOUT,TXT
- +3 SET CT=0
- +4 SET MAGRY(0)="1^Checking for Required parameter values..."
- +5 IF IDFN=""
- SET CT=CT+1
- SET MAGRY(CT)="DFN is Required. !"
- +6 IF '$DATA(IMAGES)
- IF 'CMTH
- SET CT=CT+1
- SET MAGRY(CT)="List of Images is Required. !"
- +7 ;
- +8 IF (PXPKG="")
- IF (DOCCTG="")
- IF (IXTYPE="")
- SET CT=CT+1
- SET MAGRY(CT)="Procedure or Category or Index Type is Required. !"
- +9 IF (PXPKG'="")
- IF (DOCCTG'="")
- SET CT=CT+1
- SET MAGRY(CT)="Procedure OR Document Category. Not BOTH. !"
- +10 ;
- +11 IF (PXPKG'="")
- IF (PXIEN="")
- IF (PXNEW'=1)
- SET CT=CT+1
- SET MAGRY(CT)="Procedure IEN is Required. !"
- +12 IF (PXPKG="")
- IF (PXIEN'="")
- SET CT=CT+1
- SET MAGRY(CT)="Procedure Package is Required. !"
- +13 IF (PXPKG'="")
- IF (PXDT="")
- SET CT=CT+1
- SET MAGRY(CT)="Procedure Date is Required. !"
- +14 ; Patch 108
- +15 IF (PXNEW=1)
- IF (PXPKG'=8925)
- IF (PXPKG'="TIU")
- SET CT=CT+1
- SET MAGRY(CT)="Only creating a new TIU note is implemented! PXPKG = 8925 or TIU"
- +16 IF (PXNEW=1)
- IF (PXIEN>0)
- SET CT=CT+1
- SET MAGRY(CT)="Procedure IEN or Procedure New. Not BOTH!"
- +17 IF ((PXNEW=0)!(PXNEW=""))
- Begin DoDot:1
- +18 IF PXSGNTYP'=""
- SET CT=CT+1
- SET MAGRY(CT)="Signature Type is not allowed with existing Package!"
- +19 IF PXTIUTTL'=""
- SET CT=CT+1
- SET MAGRY(CT)="TIU Title is not allowed with existing Package!"
- +20 QUIT
- End DoDot:1
- +21 IF (PXPKG="TIU")!(PXPKG=8925)
- Begin DoDot:1
- +22 IF (PXNEW=1)
- IF (PXSGNTYP'=0)
- IF (PXSGNTYP'=1)
- SET CT=CT+1
- SET MAGRY(CT)="Signature Type Unsigned (0) or Electronically Filed (1) Only!"
- +23 IF (PXNEW=1)
- IF (PXTIUTTL="")
- SET CT=CT+1
- SET MAGRY(CT)="TIU Title is Required!"
- +24 ; DOCCTG is blank
- DO ADTTLOK^MAGGSIU2(.MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE)
- +25 IF 'MAGOUT
- SET CT=CT+1
- SET MAGRY(CT)="TIU ADVANCE DIRECTIVE check: "_$PIECE(MAGOUT,U,2)
- +26 QUIT
- End DoDot:1
- +27 ; If we don't link the image then Type Index cannot be ADVANCE DIRECTIVE
- +28 IF (PXPKG'="TIU")
- IF (PXPKG'=8925)
- Begin DoDot:1
- +29 ; Get Type Index text value
- SET TXT=$$TYPIXTXT^MAGGSIU2(IXTYPE,DOCCTG)
- +30 IF TXT="ADVANCE DIRECTIVE"
- SET CT=CT+1
- SET MAGRY(CT)="ADVANCE DIRECTIVE Type Index is not allowed"
- +31 QUIT
- End DoDot:1
- +32 ;
- +33 ;Patch 8 index field check... could be using Patch 7 or Patch 8.
- +34 ; We're this far, so either PXIEN or DOCCTG is defined
- +35 IF (IXTYPE'="")
- IF (DOCCTG'="")
- SET CT=CT+1
- SET MAGRY(CT)="Image Type OR Document Category. Not BOTH. !"
- +36 ; MAGGSIA computes PACKAGE #40 and CLASS #41 when adding an Image (2005) entry.
- +37 ;
- +38 IF TRKID=""
- SET CT=CT+1
- SET MAGRY(CT)="Tracking ID is Required. !"
- +39 IF ACQD=""
- SET CT=CT+1
- SET MAGRY(CT)="Acquisition Device is Required. !"
- +40 ; ACQS ( could ? ) default to users institution i.e. DUZ(2)
- +41 IF (ACQS="")&(ACQN="")
- SET CT=CT+1
- SET MAGRY(CT)="Acquisition Site IEN or Station Number is Required. !"
- +42 IF (ACQS]"")&(ACQN]"")
- SET CT=CT+1
- SET MAGRY(CT)="Station IEN or Station Number, Not BOTH. !"
- +43 ;
- +44 IF STSCB=""
- SET CT=CT+1
- SET MAGRY(CT)="Status Handler (TAG^ROUTINE) is Required. !"
- +45 ;
- +46 IF (DOCCTG'="")
- IF (DOCDT="")
- SET CT=CT+1
- SET MAGRY(CT)="Document Date is Required. !"
- +47 ;
- +48 IF (CT>0)
- SET MAGRY(0)="0^Required parameter is null"
- QUIT MAGRY(0)
- +49 ;Checks to stop Duplicate or incorrect Tracking ID's
- +50 ; //TODO: ?? check the Queue File, is this Tracking ID already Queued.
- +51 IF (TRKID'="")
- IF $DATA(^MAG(2005,"ATRKID",TRKID))
- SET MAGRY(0)="0^Tracking ID Must be Unique !"
- +52 IF (TRKID'="")
- IF ($LENGTH(TRKID,";")<2)
- SET MAGRY(0)="0^Tracking ID Must have "";"" Delimiter"
- +53 ;
- +54 QUIT MAGRY(0)
- +55 ;
- +56 ;***** We are forcing any IMAGE that has INDEX TYPE = ADVANCE DIRECTIVE
- +57 ; to be associated with a Progress Note of Doc Class ADVANCE DIRECTIVE
- +58 ; And any Note that is an ADVANCE DIRECTIVE to have an INDEX TYPE of ADVANCE DIRECTIVE
- +59 ;
- +60 ; Input Parameters
- +61 ; ================
- +62 ; PXNEW - Flag if we are creating a new TIU Note 1- YES, 0 - NO
- +63 ; PXIEN - Existing TIU Note (IEN in file #8925)
- +64 ; PXTIUTTL - TIU Title in file #8925.1 - Could be Integer (IEN) or text
- +65 ; IXTYPE - Image Index Type IEN or Text - file #2005.83
- +66 ;
- +67 ; Return Values
- +68 ; =============
- +69 ; if check did not passed
- +70 ; MAGOUT = "0^Error message"
- +71 ; if check passed
- +72 ; MAGOUT = "1"
- +73 ;
- ADTTLOK(MAGOUT,PXNEW,PXIEN,PXTIUTTL,IXTYPE) ;
- +1 ; if index type is not set for existing note don't check for advance directive
- +2 IF (PXNEW'=1)
- IF (IXTYPE="")
- SET MAGOUT=1
- QUIT
- +3 ;
- +4 NEW TIEN,ADVTITLE,TYPETXT
- +5 IF PXNEW=1
- Begin DoDot:1
- +6 SET TIEN=""
- +7 IF '$$GETTIUDA^MAGGSIV(.MAGOUT,PXTIUTTL,.TIEN)
- QUIT
- +8 DO ISDOCCL^MAGGNTI(.ADVTITLE,+TIEN,8925.1,"ADVANCE DIRECTIVE")
- +9 QUIT
- End DoDot:1
- if 'MAGOUT
- QUIT
- +10 IF PXNEW'=1
- Begin DoDot:1
- +11 DO ISDOCCL^MAGGNTI(.ADVTITLE,+PXIEN,8925,"ADVANCE DIRECTIVE")
- +12 QUIT
- End DoDot:1
- +13 ; Get Index Type Text
- +14 SET TYPETXT=$SELECT(IXTYPE?1.N:$$GET1^DIQ(2005.83,IXTYPE_",",.01),1:IXTYPE)
- +15 ;
- +16 ; Index Type must be ADVANCE DIRECTIVE
- IF +ADVTITLE
- Begin DoDot:1
- +17 IF TYPETXT="ADVANCE DIRECTIVE"
- SET MAGOUT=1
- QUIT
- +18 SET MAGOUT="0^Index Type must be ADVANCE DIRECTIVE"
- QUIT
- +19 QUIT
- End DoDot:1
- QUIT
- +20 ; TIU Title is not ADVANCE DIRECTIVE - Check the index
- +21 IF TYPETXT="ADVANCE DIRECTIVE"
- Begin DoDot:1
- +22 IF (PXIEN'="")!(PXTIUTTL'="")
- SET MAGOUT="0^TIU Note must be ADVANCE DIRECTIVE"
- QUIT
- +23 SET MAGOUT="0^ADVANCE DIRECTIVE Type Index is not allowed"
- +24 QUIT
- End DoDot:1
- QUIT
- +25 ;
- +26 ; Image Type Index is not ADVANCE DIRECTIVE
- SET MAGOUT=1
- +27 QUIT
- +28 ;
- +29 ; IXTYPE - Type Index - IEN or text
- +30 ; DOCCTG - Document Category IEN or text
- TYPIXTXT(IXTYPE,DOCCTG) ; Get Type Index Text
- +1 NEW MAGR
- +2 IF IXTYPE?1.N
- QUIT $$GET1^DIQ(2005.83,IXTYPE_",",.01)
- +3 IF IXTYPE=""
- IF DOCCTG=""
- QUIT ""
- +4 ; return external value of field 42
- IF DOCCTG?1.N
- QUIT $$GET1^DIQ(2005.81,DOCCTG_",",42)
- +5 DO CHK^DIE(2005,100,"E",DOCCTG,.MAGR,"MAGMSG")
- +6 IF MAGR="^"
- QUIT ""
- +7 ; return external value of field 42
- QUIT $$GET1^DIQ(2005.81,MAGR_",",42)