- 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 Feb 18, 2025@23:29:01 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