MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU. RPC Calls etc. ; OCT 12, 2020@10:02 AM
;;3.0;IMAGING;**46,59,282**;Nov 27, 2007;Build 18
;;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
; gek/9/23/2020 Modification to return only TIU TITLES that are
; exact Matches with the user input
; Also, enable sending '[]' as place holder for space
; this function will $TRanspose '[]' into ' '
; IA#2322 covers calls to TIU Routine TIULP
LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES]
; Get a list of Document Titles
; CLASS = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
; CLASS IEN is any IEN of TIU 8925.1 that is a Class
; "|" delimited string of Class| text | Direction
; 3.0.282 if 'text' contains ';1' i.e. 'text;1'
; then the result array will only contain exact
; matches to 'text'
; MYLIST = [1|""] optional
; If MYLIST=1 then return
; TIU PERSONAL TITLE LIST PERSLIST^TIUSRVD
;
; Note : sending CLASS IEN isn't used in p282.
;
K MAGRY
; was a Global, now leave it an Array, only getting 44
N I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
N INTXT,UPDN,TARR,ALTLKP
S MYLIST=$G(MYLIST)
; ALTLKP (MAG*3.0*282) determines if alternate lookups
; are used. If ALTLKP=1 perform the Exact Hit lookup.
S ALTLKP=0
S INTXT=$P(CLASS,"|",2)
S INTXT=$TR(INTXT,"[]"," ")
S ALTLKP=+$P(INTXT,";",2)
S INTXT=$P(INTXT,";",1)
S UPDN=$S(+$P(CLASS,"|",3):+$P(CLASS,"|",3),1:1)
S CLASS=$P(CLASS,"|",1)
I $L(CLASS)=0 S MAGRY(0)="0^Invalid Selection: CLASS." Q
; get the IEN's for the CLASS's
S CLNOTE=3 ; It is hard coded in TIU code. Note Class
S CLDS=244 ; It is hard coded in TIU code. Discharge Summary Class
D CPCLASS^TIUCP(.CLCP)
D CNSLCLAS^TIUSRVD(.CLCONS)
D SURGCLAS^TIUSRVD(.CLSUR)
S MAGRY(0)="0^0 Items match Input: "_INTXT_" for Class: "_CLASS
S MAGRY(1)="key word^TITLE^CLASS"
S I=""
F I=1:1:$L(CLASS,",") D
. S CL=$P(CLASS,",",I)
. S CLN=$S(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
. I MYLIST D Q
. . D MYLIST(CLN,.TARR)
. . I $O(TARR(""))'="" S MAGRY(0)="1^Personal List"
. . S J="" F S J=$O(TARR(J)) Q:J="" D
. . . S TX1=$P(TARR(J),"^",1)
. . . ; output has 'd' or 'i' as first character, we need to get rid of it.
. . . I $E(TX1)="d" S DFLT=$E(TX1,2,999),MAGRY(0)=DFLT_"^Personal list"
. . . S TX1=$E(TX1,2,999)
. . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
. . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
. . . Q
. . Q
. ;
. I ALTLKP=1 D EXACTHIT(.MAGRY,INTXT,CLN,CL) Q
. K TARR
. D BLDLIST(CLN,.TARR,INTXT,UPDN)
. S J="" F S J=$O(TARR(J)) Q:J="" D
. . S TX=$P(TARR(J),"^",2)
. . S TX1=$P(TARR(J),"^",1)
. . I $L(TX,"<")>1 S TX=$P(TX,"<",1)_"^<"_$P(TX,"<",2)
. . E S TX=TX_" ^<"_TX_">"
. . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_CL_"|"_TX1
. . Q
. Q
I '$D(MAGRY(2)) K MAGRY(1) Q
E S MAGRY(0)="1^Success"_"^"_$G(DFLT)_"^"
Q
;
INACL(INTXT,CLID,CLNAME,CLIEN,DESC) ;
; Here we check to see if our IEN (CLIEN) is in the
; ACL Index for the Class (CLID)
; DESC is passed by Reference and returned formatted.
N FROM,I,DA,FOUND,DONE,TX,TX1,TX2
S I=0
S FROM=$E(INTXT,1,$L(INTXT)-1)
S FOUND=0
F S FROM=$O(^TIU(8925.1,"ACL",CLID,FROM)) Q:FROM="" D Q:FOUND
. S DA=0
. F S DA=$O(^TIU(8925.1,"ACL",CLID,FROM,DA)) Q:+DA'>0 D
. . Q:DA'=CLIEN ; we're only checking for IEN we sent.
. . ;IA#2322 for CANENTR and ;IA#2322 for CANPICK
. . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
. . ;We're here, so the CLIEN we were checking is good.
. . S FOUND=1
. . ; Reformat the Output
. . S TX=FROM
. . S TX1=DA
. . I $L(TX,"<")>1 S TX=$P(TX,"<",1)_"^<"_$P(TX,"<",2)
. . E S TX=TX_" ^<"_TX_">"
. . S DESC=TX_"^"_CL_"|"_TX1
. . Q
Q FOUND
;
EXACTHIT(MAGRY,INTXT,CLID,CLNAME) ;
; We are here if INTXT is formatted xxx;1 this tells us the caller
; wants ONLY TIU TITLEs that Match the input xxx for the CLASS.
; CLID is the ID of the CLASS of Title.
; i.e. (NOTE,CONS,DS etc) that we are looking for.
N IN29,TLST,IL,ECT,THIEN,FANY,MAGM,MCT,DESC
N ISCONS
; Here we are looking into TIU DOCUMENT DEFINITION file for entries
; starting with INTXT, and are Type = DOC (DOC is a set, it converts to TITLE)
; Search on first 29 Characters
S IN29=$E(INTXT,1,29)
D LKP^MAGGNLKP(.TLST,"8925.1^101^"_IN29_"^^I $P(^TIU(8925.1,Y,0),U,4)=""DOC""")
I '$D(TLST(0)) Q
S MCT=1,FANY=0
S ECT=$P(TLST(0),"^",1) I ECT=0 Q
S IL=0
F S IL=$O(TLST(IL)) Q:'IL D ;
. ; check that the found entries, match the user input.
. I $E($P(TLST(IL),"^",1),1,$L(INTXT))'=INTXT Q
. S ISCONS=0
. S THIEN=$P(TLST(IL),"^",2)
. I CLNAME="NOTE" D Q:ISCONS
. . D ISCNSLT^TIUCNSLT(.ISCONS,THIEN)
. . Q
. S DESC=""
. IF $$INACL(INTXT,CLID,CLNAME,THIEN,.DESC) D ;
. . S MCT=MCT+1,MAGM(MCT)=DESC,FANY=1
. Q
I 'FANY Q ;
S IL=0 F S IL=$O(MAGM(IL)) Q:IL="" D ;
. S MAGRY($O(MAGRY(""),-1)+1)=MAGM(IL)
Q
MYLIST(CLN,TARR) ;
; if not short list, default is listed twice, (This is how CPRS displays it)
K TARR
D PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
Q
BLDLIST(CLN,TARR,STC,UPDN) ;
;
S UPDN=$S(+$G(UPDN):+$G(UPDN),1:1)
K TARR
D LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
Q
ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
; RPC Call to Administratively Close a TIU Note.
; - - - Required - - -
; MAGDFN - Patient DFN
; MAGTIUDA - Note IEN in File 8925
; - - - Optional - - -
; MAGMODE - "S" Scanned Document "M" - Manual closure "E" - Electronically Filed.
;
S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA),MAGMODE=$G(MAGMODE,"S")
I '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA) Q
; Calling TIU SET ADMINISTRATIVE CLOSURE
; MAGMODE can be "S" for SCANNED DOCUMENT <- HIMS may get this changed
; to Electronically Filed.
; or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE
D ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
; on success MAGRY = MAGTIUDA
; on error MAGRY = 0^<message>
I MAGRY S MAGRY=MAGRY_"^Success: Administrative Closure."
Q
VALES(X) ; Validate the esig
N MAGY S MAGY=0
D HASH^ROUTINE
I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S MAGY=1
Q MAGY
VALDATA(RY,MAGDFN,MAGTIUDA) ; Validate the TIUDA and the DFN
S MAGTIUDA=$G(MAGTIUDA),MAGDFN=$G(MAGDFN)
I 'MAGDFN S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
I '$D(^DPT(+MAGDFN,0)) S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
I 'MAGTIUDA S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
I '$D(^TIU(8925,MAGTIUDA,0)) S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
I $P(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN S RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA Q 0
S RY="1^Validated OK."
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGNTI2 8115 printed Sep 23, 2025@19:38:46 Page 2
MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU. RPC Calls etc. ; OCT 12, 2020@10:02 AM
+1 ;;3.0;IMAGING;**46,59,282**;Nov 27, 2007;Build 18
+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
+18 ; gek/9/23/2020 Modification to return only TIU TITLES that are
+19 ; exact Matches with the user input
+20 ; Also, enable sending '[]' as place holder for space
+21 ; this function will $TRanspose '[]' into ' '
+22 ; IA#2322 covers calls to TIU Routine TIULP
LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES]
+1 ; Get a list of Document Titles
+2 ; CLASS = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
+3 ; CLASS IEN is any IEN of TIU 8925.1 that is a Class
+4 ; "|" delimited string of Class| text | Direction
+5 ; 3.0.282 if 'text' contains ';1' i.e. 'text;1'
+6 ; then the result array will only contain exact
+7 ; matches to 'text'
+8 ; MYLIST = [1|""] optional
+9 ; If MYLIST=1 then return
+10 ; TIU PERSONAL TITLE LIST PERSLIST^TIUSRVD
+11 ;
+12 ; Note : sending CLASS IEN isn't used in p282.
+13 ;
+14 KILL MAGRY
+15 ; was a Global, now leave it an Array, only getting 44
+16 NEW I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
+17 NEW INTXT,UPDN,TARR,ALTLKP
+18 SET MYLIST=$GET(MYLIST)
+19 ; ALTLKP (MAG*3.0*282) determines if alternate lookups
+20 ; are used. If ALTLKP=1 perform the Exact Hit lookup.
+21 SET ALTLKP=0
+22 SET INTXT=$PIECE(CLASS,"|",2)
+23 SET INTXT=$TRANSLATE(INTXT,"[]"," ")
+24 SET ALTLKP=+$PIECE(INTXT,";",2)
+25 SET INTXT=$PIECE(INTXT,";",1)
+26 SET UPDN=$SELECT(+$PIECE(CLASS,"|",3):+$PIECE(CLASS,"|",3),1:1)
+27 SET CLASS=$PIECE(CLASS,"|",1)
+28 IF $LENGTH(CLASS)=0
SET MAGRY(0)="0^Invalid Selection: CLASS."
QUIT
+29 ; get the IEN's for the CLASS's
+30 ; It is hard coded in TIU code. Note Class
SET CLNOTE=3
+31 ; It is hard coded in TIU code. Discharge Summary Class
SET CLDS=244
+32 DO CPCLASS^TIUCP(.CLCP)
+33 DO CNSLCLAS^TIUSRVD(.CLCONS)
+34 DO SURGCLAS^TIUSRVD(.CLSUR)
+35 SET MAGRY(0)="0^0 Items match Input: "_INTXT_" for Class: "_CLASS
+36 SET MAGRY(1)="key word^TITLE^CLASS"
+37 SET I=""
+38 FOR I=1:1:$LENGTH(CLASS,",")
Begin DoDot:1
+39 SET CL=$PIECE(CLASS,",",I)
+40 SET CLN=$SELECT(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
+41 IF MYLIST
Begin DoDot:2
+42 DO MYLIST(CLN,.TARR)
+43 IF $ORDER(TARR(""))'=""
SET MAGRY(0)="1^Personal List"
+44 SET J=""
FOR
SET J=$ORDER(TARR(J))
if J=""
QUIT
Begin DoDot:3
+45 SET TX1=$PIECE(TARR(J),"^",1)
+46 ; output has 'd' or 'i' as first character, we need to get rid of it.
+47 IF $EXTRACT(TX1)="d"
SET DFLT=$EXTRACT(TX1,2,999)
SET MAGRY(0)=DFLT_"^Personal list"
+48 SET TX1=$EXTRACT(TX1,2,999)
+49 SET TX=$PIECE(TARR(J),"^",2)
SET TX2=$PIECE(TX,"<",2)
if $LENGTH(TX2)
SET TX=$PIECE(TX,"<",1)
if $LENGTH(TX2)
SET TX2="<"_TX2
+50 SET MAGRY($ORDER(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
+51 QUIT
End DoDot:3
+52 QUIT
End DoDot:2
QUIT
+53 ;
+54 IF ALTLKP=1
DO EXACTHIT(.MAGRY,INTXT,CLN,CL)
QUIT
+55 KILL TARR
+56 DO BLDLIST(CLN,.TARR,INTXT,UPDN)
+57 SET J=""
FOR
SET J=$ORDER(TARR(J))
if J=""
QUIT
Begin DoDot:2
+58 SET TX=$PIECE(TARR(J),"^",2)
+59 SET TX1=$PIECE(TARR(J),"^",1)
+60 IF $LENGTH(TX,"<")>1
SET TX=$PIECE(TX,"<",1)_"^<"_$PIECE(TX,"<",2)
+61 IF '$TEST
SET TX=TX_" ^<"_TX_">"
+62 SET MAGRY($ORDER(MAGRY(""),-1)+1)=TX_"^"_CL_"|"_TX1
+63 QUIT
End DoDot:2
+64 QUIT
End DoDot:1
+65 IF '$DATA(MAGRY(2))
KILL MAGRY(1)
QUIT
+66 IF '$TEST
SET MAGRY(0)="1^Success"_"^"_$GET(DFLT)_"^"
+67 QUIT
+68 ;
INACL(INTXT,CLID,CLNAME,CLIEN,DESC) ;
+1 ; Here we check to see if our IEN (CLIEN) is in the
+2 ; ACL Index for the Class (CLID)
+3 ; DESC is passed by Reference and returned formatted.
+4 NEW FROM,I,DA,FOUND,DONE,TX,TX1,TX2
+5 SET I=0
+6 SET FROM=$EXTRACT(INTXT,1,$LENGTH(INTXT)-1)
+7 SET FOUND=0
+8 FOR
SET FROM=$ORDER(^TIU(8925.1,"ACL",CLID,FROM))
if FROM=""
QUIT
Begin DoDot:1
+9 SET DA=0
+10 FOR
SET DA=$ORDER(^TIU(8925.1,"ACL",CLID,FROM,DA))
if +DA'>0
QUIT
Begin DoDot:2
+11 ; we're only checking for IEN we sent.
if DA'=CLIEN
QUIT
+12 ;IA#2322 for CANENTR and ;IA#2322 for CANPICK
+13 IF $SELECT(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0)
QUIT
+14 ;We're here, so the CLIEN we were checking is good.
+15 SET FOUND=1
+16 ; Reformat the Output
+17 SET TX=FROM
+18 SET TX1=DA
+19 IF $LENGTH(TX,"<")>1
SET TX=$PIECE(TX,"<",1)_"^<"_$PIECE(TX,"<",2)
+20 IF '$TEST
SET TX=TX_" ^<"_TX_">"
+21 SET DESC=TX_"^"_CL_"|"_TX1
+22 QUIT
End DoDot:2
End DoDot:1
if FOUND
QUIT
+23 QUIT FOUND
+24 ;
EXACTHIT(MAGRY,INTXT,CLID,CLNAME) ;
+1 ; We are here if INTXT is formatted xxx;1 this tells us the caller
+2 ; wants ONLY TIU TITLEs that Match the input xxx for the CLASS.
+3 ; CLID is the ID of the CLASS of Title.
+4 ; i.e. (NOTE,CONS,DS etc) that we are looking for.
+5 NEW IN29,TLST,IL,ECT,THIEN,FANY,MAGM,MCT,DESC
+6 NEW ISCONS
+7 ; Here we are looking into TIU DOCUMENT DEFINITION file for entries
+8 ; starting with INTXT, and are Type = DOC (DOC is a set, it converts to TITLE)
+9 ; Search on first 29 Characters
+10 SET IN29=$EXTRACT(INTXT,1,29)
+11 DO LKP^MAGGNLKP(.TLST,"8925.1^101^"_IN29_"^^I $P(^TIU(8925.1,Y,0),U,4)=""DOC""")
+12 IF '$DATA(TLST(0))
QUIT
+13 SET MCT=1
SET FANY=0
+14 SET ECT=$PIECE(TLST(0),"^",1)
IF ECT=0
QUIT
+15 SET IL=0
+16 ;
FOR
SET IL=$ORDER(TLST(IL))
if 'IL
QUIT
Begin DoDot:1
+17 ; check that the found entries, match the user input.
+18 IF $EXTRACT($PIECE(TLST(IL),"^",1),1,$LENGTH(INTXT))'=INTXT
QUIT
+19 SET ISCONS=0
+20 SET THIEN=$PIECE(TLST(IL),"^",2)
+21 IF CLNAME="NOTE"
Begin DoDot:2
+22 DO ISCNSLT^TIUCNSLT(.ISCONS,THIEN)
+23 QUIT
End DoDot:2
if ISCONS
QUIT
+24 SET DESC=""
+25 ;
IF $$INACL(INTXT,CLID,CLNAME,THIEN,.DESC)
Begin DoDot:2
+26 SET MCT=MCT+1
SET MAGM(MCT)=DESC
SET FANY=1
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;
IF 'FANY
QUIT
+29 ;
SET IL=0
FOR
SET IL=$ORDER(MAGM(IL))
if IL=""
QUIT
Begin DoDot:1
+30 SET MAGRY($ORDER(MAGRY(""),-1)+1)=MAGM(IL)
End DoDot:1
+31 QUIT
MYLIST(CLN,TARR) ;
+1 ; if not short list, default is listed twice, (This is how CPRS displays it)
+2 KILL TARR
+3 DO PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
+4 QUIT
BLDLIST(CLN,TARR,STC,UPDN) ;
+1 ;
+2 SET UPDN=$SELECT(+$GET(UPDN):+$GET(UPDN),1:1)
+3 KILL TARR
+4 DO LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
+5 QUIT
ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
+1 ; RPC Call to Administratively Close a TIU Note.
+2 ; - - - Required - - -
+3 ; MAGDFN - Patient DFN
+4 ; MAGTIUDA - Note IEN in File 8925
+5 ; - - - Optional - - -
+6 ; MAGMODE - "S" Scanned Document "M" - Manual closure "E" - Electronically Filed.
+7 ;
+8 SET MAGDFN=$GET(MAGDFN)
SET MAGTIUDA=$GET(MAGTIUDA)
SET MAGMODE=$GET(MAGMODE,"S")
+9 IF '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA)
QUIT
+10 ; Calling TIU SET ADMINISTRATIVE CLOSURE
+11 ; MAGMODE can be "S" for SCANNED DOCUMENT <- HIMS may get this changed
+12 ; to Electronically Filed.
+13 ; or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE
+14 DO ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
+15 ; on success MAGRY = MAGTIUDA
+16 ; on error MAGRY = 0^<message>
+17 IF MAGRY
SET MAGRY=MAGRY_"^Success: Administrative Closure."
+18 QUIT
VALES(X) ; Validate the esig
+1 NEW MAGY
SET MAGY=0
+2 DO HASH^ROUTINE
+3 IF X]""
IF (X=$PIECE($GET(^VA(200,+DUZ,20)),U,4))
SET MAGY=1
+4 QUIT MAGY
VALDATA(RY,MAGDFN,MAGTIUDA) ; Validate the TIUDA and the DFN
+1 SET MAGTIUDA=$GET(MAGTIUDA)
SET MAGDFN=$GET(MAGDFN)
+2 IF 'MAGDFN
SET RY="0^Invalid data: Patient DFN invalid: "_MAGDFN
QUIT 0
+3 IF '$DATA(^DPT(+MAGDFN,0))
SET RY="0^Invalid data: Patient DFN invalid: "_MAGDFN
QUIT 0
+4 IF 'MAGTIUDA
SET RY="0^Invalid Note IEN: "_MAGTIUDA
QUIT 0
+5 IF '$DATA(^TIU(8925,MAGTIUDA,0))
SET RY="0^Invalid Note IEN: "_MAGTIUDA
QUIT 0
+6 IF $PIECE(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN
SET RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA
QUIT 0
+7 SET RY="1^Validated OK."
+8 QUIT 1
