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

MAGGNTI2.m

Go to the documentation of this file.
  1. 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
  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. ; gek/9/23/2020 Modification to return only TIU TITLES that are
  1. ; exact Matches with the user input
  1. ; Also, enable sending '[]' as place holder for space
  1. ; this function will $TRanspose '[]' into ' '
  1. ; IA#2322 covers calls to TIU Routine TIULP
  1. LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES]
  1. ; Get a list of Document Titles
  1. ; CLASS = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
  1. ; CLASS IEN is any IEN of TIU 8925.1 that is a Class
  1. ; "|" delimited string of Class| text | Direction
  1. ; 3.0.282 if 'text' contains ';1' i.e. 'text;1'
  1. ; then the result array will only contain exact
  1. ; matches to 'text'
  1. ; MYLIST = [1|""] optional
  1. ; If MYLIST=1 then return
  1. ; TIU PERSONAL TITLE LIST PERSLIST^TIUSRVD
  1. ;
  1. ; Note : sending CLASS IEN isn't used in p282.
  1. ;
  1. K MAGRY
  1. ; was a Global, now leave it an Array, only getting 44
  1. N I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
  1. N INTXT,UPDN,TARR,ALTLKP
  1. S MYLIST=$G(MYLIST)
  1. ; ALTLKP (MAG*3.0*282) determines if alternate lookups
  1. ; are used. If ALTLKP=1 perform the Exact Hit lookup.
  1. S ALTLKP=0
  1. S INTXT=$P(CLASS,"|",2)
  1. S INTXT=$TR(INTXT,"[]"," ")
  1. S ALTLKP=+$P(INTXT,";",2)
  1. S INTXT=$P(INTXT,";",1)
  1. S UPDN=$S(+$P(CLASS,"|",3):+$P(CLASS,"|",3),1:1)
  1. S CLASS=$P(CLASS,"|",1)
  1. I $L(CLASS)=0 S MAGRY(0)="0^Invalid Selection: CLASS." Q
  1. ; get the IEN's for the CLASS's
  1. S CLNOTE=3 ; It is hard coded in TIU code. Note Class
  1. S CLDS=244 ; It is hard coded in TIU code. Discharge Summary Class
  1. D CPCLASS^TIUCP(.CLCP)
  1. D CNSLCLAS^TIUSRVD(.CLCONS)
  1. D SURGCLAS^TIUSRVD(.CLSUR)
  1. S MAGRY(0)="0^0 Items match Input: "_INTXT_" for Class: "_CLASS
  1. S MAGRY(1)="key word^TITLE^CLASS"
  1. S I=""
  1. F I=1:1:$L(CLASS,",") D
  1. . S CL=$P(CLASS,",",I)
  1. . S CLN=$S(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
  1. . I MYLIST D Q
  1. . . D MYLIST(CLN,.TARR)
  1. . . I $O(TARR(""))'="" S MAGRY(0)="1^Personal List"
  1. . . S J="" F S J=$O(TARR(J)) Q:J="" D
  1. . . . S TX1=$P(TARR(J),"^",1)
  1. . . . ; output has 'd' or 'i' as first character, we need to get rid of it.
  1. . . . I $E(TX1)="d" S DFLT=$E(TX1,2,999),MAGRY(0)=DFLT_"^Personal list"
  1. . . . S TX1=$E(TX1,2,999)
  1. . . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
  1. . . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
  1. . . . Q
  1. . . Q
  1. . ;
  1. . I ALTLKP=1 D EXACTHIT(.MAGRY,INTXT,CLN,CL) Q
  1. . K TARR
  1. . D BLDLIST(CLN,.TARR,INTXT,UPDN)
  1. . S J="" F S J=$O(TARR(J)) Q:J="" D
  1. . . S TX=$P(TARR(J),"^",2)
  1. . . S TX1=$P(TARR(J),"^",1)
  1. . . I $L(TX,"<")>1 S TX=$P(TX,"<",1)_"^<"_$P(TX,"<",2)
  1. . . E S TX=TX_" ^<"_TX_">"
  1. . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_CL_"|"_TX1
  1. . . Q
  1. . Q
  1. I '$D(MAGRY(2)) K MAGRY(1) Q
  1. E S MAGRY(0)="1^Success"_"^"_$G(DFLT)_"^"
  1. Q
  1. ;
  1. INACL(INTXT,CLID,CLNAME,CLIEN,DESC) ;
  1. ; Here we check to see if our IEN (CLIEN) is in the
  1. ; ACL Index for the Class (CLID)
  1. ; DESC is passed by Reference and returned formatted.
  1. N FROM,I,DA,FOUND,DONE,TX,TX1,TX2
  1. S I=0
  1. S FROM=$E(INTXT,1,$L(INTXT)-1)
  1. S FOUND=0
  1. F S FROM=$O(^TIU(8925.1,"ACL",CLID,FROM)) Q:FROM="" D Q:FOUND
  1. . S DA=0
  1. . F S DA=$O(^TIU(8925.1,"ACL",CLID,FROM,DA)) Q:+DA'>0 D
  1. . . Q:DA'=CLIEN ; we're only checking for IEN we sent.
  1. . . ;IA#2322 for CANENTR and ;IA#2322 for CANPICK
  1. . . I $S(+$$CANENTR^TIULP(DA)'>0:1,+$$CANPICK^TIULP(DA)'>0:1,1:0) Q
  1. . . ;We're here, so the CLIEN we were checking is good.
  1. . . S FOUND=1
  1. . . ; Reformat the Output
  1. . . S TX=FROM
  1. . . S TX1=DA
  1. . . I $L(TX,"<")>1 S TX=$P(TX,"<",1)_"^<"_$P(TX,"<",2)
  1. . . E S TX=TX_" ^<"_TX_">"
  1. . . S DESC=TX_"^"_CL_"|"_TX1
  1. . . Q
  1. Q FOUND
  1. ;
  1. EXACTHIT(MAGRY,INTXT,CLID,CLNAME) ;
  1. ; We are here if INTXT is formatted xxx;1 this tells us the caller
  1. ; wants ONLY TIU TITLEs that Match the input xxx for the CLASS.
  1. ; CLID is the ID of the CLASS of Title.
  1. ; i.e. (NOTE,CONS,DS etc) that we are looking for.
  1. N IN29,TLST,IL,ECT,THIEN,FANY,MAGM,MCT,DESC
  1. N ISCONS
  1. ; Here we are looking into TIU DOCUMENT DEFINITION file for entries
  1. ; starting with INTXT, and are Type = DOC (DOC is a set, it converts to TITLE)
  1. ; Search on first 29 Characters
  1. S IN29=$E(INTXT,1,29)
  1. D LKP^MAGGNLKP(.TLST,"8925.1^101^"_IN29_"^^I $P(^TIU(8925.1,Y,0),U,4)=""DOC""")
  1. I '$D(TLST(0)) Q
  1. S MCT=1,FANY=0
  1. S ECT=$P(TLST(0),"^",1) I ECT=0 Q
  1. S IL=0
  1. F S IL=$O(TLST(IL)) Q:'IL D ;
  1. . ; check that the found entries, match the user input.
  1. . I $E($P(TLST(IL),"^",1),1,$L(INTXT))'=INTXT Q
  1. . S ISCONS=0
  1. . S THIEN=$P(TLST(IL),"^",2)
  1. . I CLNAME="NOTE" D Q:ISCONS
  1. . . D ISCNSLT^TIUCNSLT(.ISCONS,THIEN)
  1. . . Q
  1. . S DESC=""
  1. . IF $$INACL(INTXT,CLID,CLNAME,THIEN,.DESC) D ;
  1. . . S MCT=MCT+1,MAGM(MCT)=DESC,FANY=1
  1. . Q
  1. I 'FANY Q ;
  1. S IL=0 F S IL=$O(MAGM(IL)) Q:IL="" D ;
  1. . S MAGRY($O(MAGRY(""),-1)+1)=MAGM(IL)
  1. Q
  1. MYLIST(CLN,TARR) ;
  1. ; if not short list, default is listed twice, (This is how CPRS displays it)
  1. K TARR
  1. D PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
  1. Q
  1. BLDLIST(CLN,TARR,STC,UPDN) ;
  1. ;
  1. S UPDN=$S(+$G(UPDN):+$G(UPDN),1:1)
  1. K TARR
  1. D LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
  1. Q
  1. ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
  1. ; RPC Call to Administratively Close a TIU Note.
  1. ; - - - Required - - -
  1. ; MAGDFN - Patient DFN
  1. ; MAGTIUDA - Note IEN in File 8925
  1. ; - - - Optional - - -
  1. ; MAGMODE - "S" Scanned Document "M" - Manual closure "E" - Electronically Filed.
  1. ;
  1. S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA),MAGMODE=$G(MAGMODE,"S")
  1. I '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA) Q
  1. ; Calling TIU SET ADMINISTRATIVE CLOSURE
  1. ; MAGMODE can be "S" for SCANNED DOCUMENT <- HIMS may get this changed
  1. ; to Electronically Filed.
  1. ; or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE
  1. D ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
  1. ; on success MAGRY = MAGTIUDA
  1. ; on error MAGRY = 0^<message>
  1. I MAGRY S MAGRY=MAGRY_"^Success: Administrative Closure."
  1. Q
  1. VALES(X) ; Validate the esig
  1. N MAGY S MAGY=0
  1. D HASH^ROUTINE
  1. I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S MAGY=1
  1. Q MAGY
  1. VALDATA(RY,MAGDFN,MAGTIUDA) ; Validate the TIUDA and the DFN
  1. S MAGTIUDA=$G(MAGTIUDA),MAGDFN=$G(MAGDFN)
  1. I 'MAGDFN S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
  1. I '$D(^DPT(+MAGDFN,0)) S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
  1. I 'MAGTIUDA S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
  1. I '$D(^TIU(8925,MAGTIUDA,0)) S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
  1. I $P(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN S RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA Q 0
  1. S RY="1^Validated OK."
  1. Q 1