source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGNTI2.m@ 648

Last change on this file since 648 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 5.2 KB
RevLine 
[623]1MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 20 Nov 2006 12:18 PM
2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES]
20 ; Get a list of Document Titles
21 ; CLASS = ("," delimited string of one or More of) "NOTE,DS,CONS,CP,SUR,<CLASS IEN>"
22 ; CLASS IEN is any IEN of TIU 8925.1 that is a Class
23 ; "|" delimited string of Class| text | Direction
24 ; MYLIST = [1|""] optional
25 ; If MYLIST=1 then return
26 ; TIU PERSONAL TITLE LIST PERSLIST^TIUSRVD
27 ;
28 ; Note : sending CLASS IEN isn't tested.
29 ;
30 K MAGRY
31 ; was a Global, now leave it an Array, only getting 44
32 N I,T,CL,CLN,CLNOTE,CLDS,CLCP,CLCONS,CLSUR,IL,J,TX,TXC,TX2,TX1,DFLT
33 N INTXT,UPDN,TARR
34 S MYLIST=$G(MYLIST)
35 S INTXT=$P(CLASS,"|",2)
36 S UPDN=$S(+$P(CLASS,"|",3):+$P(CLASS,"|",3),1:1)
37 S CLASS=$P(CLASS,"|",1)
38 I $L(CLASS)=0 S MAGRY(0)="0^Invalid Selection Class." Q
39 S CLNOTE=3 ; It is hard coded in TIU code. Note Class
40 S CLDS=244 ; It is hard coded in TIU code. Discharge Summary Class
41 D CPCLASS^TIUCP(.CLCP)
42 D CNSLCLAS^TIUSRVD(.CLCONS)
43 D SURGCLAS^TIUSRVD(.CLSUR)
44 S MAGRY(0)="0^Error: While accessing a list of Note Titles."
45 S MAGRY(1)="key word^TITLE^CLASS"
46 S I=""
47 F I=1:1:$L(CLASS,",") D
48 . S CL=$P(CLASS,",",I)
49 . S CLN=$S(+CL:+CL,CL="NOTE":3,CL="DS":CLDS,CL="CP":CLCP,CL="CONS":CLCONS,CL="SUR":CLSUR,1:-1)
50 . I MYLIST D Q
51 . . D MYLIST(CLN,.TARR)
52 . . I $O(TARR(""))'="" S MAGRY(0)="1^Personal List"
53 . . S J="" F S J=$O(TARR(J)) Q:J="" D
54 . . . S TX1=$P(TARR(J),"^",1)
55 . . . ; output has 'd' or 'i' as first character, we need to get rid of it.
56 . . . I $E(TX1)="d" S DFLT=$E(TX1,2,999),MAGRY(0)=DFLT_"^Personal list"
57 . . . S TX1=$E(TX1,2,999)
58 . . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
59 . . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
60 . . . Q
61 . . Q
62 . ; here add line as a break between Personal List and Start of Total List
63 . K TARR
64 . D BLDLIST(CLN,.TARR,INTXT,UPDN)
65 . S J="" F S J=$O(TARR(J)) Q:J="" D
66 . . S TX=$P(TARR(J),"^",2),TX2=$P(TX,"<",2) S:$L(TX2) TX=$P(TX,"<",1) S:$L(TX2) TX2="<"_TX2
67 . . S TX1=$P(TARR(J),"^",1)
68 . . S MAGRY($O(MAGRY(""),-1)+1)=TX_"^"_TX2_"^"_CL_"|"_TX1
69 . . Q
70 . Q
71 I '$D(MAGRY(2)) K MAGRY(1) S MAGRY(0)="0^0 Items match input: "_INTXT
72 E S MAGRY(0)="1^Success"_"^"_$G(DFLT)_"^"
73 Q
74 ;
75MYLIST(CLN,TARR) ;
76 ; if not short list, default is listed twice, (This is how CPRS displays it)
77 K TARR
78 D PERSLIST^TIUSRVD(.TARR,DUZ,CLN)
79 Q
80BLDLIST(CLN,TARR,STC,UPDN) ;
81 ;
82 S UPDN=$S(+$G(UPDN):+$G(UPDN),1:1)
83 K TARR
84 D LONGLIST^TIUSRVD(.TARR,CLN,STC,UPDN)
85 Q
86ADMNCLOS(MAGRY,MAGDFN,MAGTIUDA,MAGMODE) ; calls TIU API to set as Admin Closed.
87 ; RPC Call to Administratively Close a TIU Note.
88 ; - - - Required - - -
89 ; MAGDFN - Patient DFN
90 ; MAGTIUDA - Note IEN in File 8925
91 ; - - - Optional - - -
92 ; MAGMODE - "S" Scanned Document "M" - Manual closure "E" - Electronically Filed.
93 ;
94 S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA),MAGMODE=$G(MAGMODE,"S")
95 I '$$VALDATA(.MAGRY,MAGDFN,MAGTIUDA) Q
96 ; Calling TIU SET ADMINISTRATIVE CLOSURE
97 ; MAGMODE can be "S" for SCANNED DOCUMENT <- HIMS may get this changed
98 ; to Electronically Filed.
99 ; or "M" for MANUAL CLOSURE or "E" for ELECTONICALL FILE
100 D ADMNCLOS^TIUSRVPT(.MAGRY,MAGTIUDA,MAGMODE)
101 ; on success MAGRY = MAGTIUDA
102 ; on error MAGRY = 0^<message>
103 I MAGRY S MAGRY=MAGRY_"^Success: Administrative Closure."
104 Q
105VALES(X) ; Validate the esig
106 N MAGY S MAGY=0
107 D HASH^XUSHSHP
108 I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S MAGY=1
109 Q MAGY
110VALDATA(RY,MAGDFN,MAGTIUDA) ; Validate the TIUDA and the DFN
111 S MAGTIUDA=$G(MAGTIUDA),MAGDFN=$G(MAGDFN)
112 I 'MAGDFN S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
113 I '$D(^DPT(+MAGDFN,0)) S RY="0^Invalid data: Patient DFN invalid: "_MAGDFN Q 0
114 I 'MAGTIUDA S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
115 I '$D(^TIU(8925,MAGTIUDA,0)) S RY="0^Invalid Note IEN: "_MAGTIUDA Q 0
116 I $P(^TIU(8925,MAGTIUDA,0),"^",2)'=MAGDFN S RY="0^Invalid Patient DFN: "_MAGDFN_" for Note: "_MAGTIUDA Q 0
117 S RY="1^Validated OK."
118 Q 1
Note: See TracBrowser for help on using the repository browser.