source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRF2.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1TIUPRF2 ; SLC/JMH - RPCs for Patient Record Flags ; 11/3/05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
3 ;
4 ; $$GETACT^DGPFAPI: IA# 3860
5 ; $$GETHTIU^DGPFAPI1: IA# 4383
6 ; $$STOTIU^DGPFAPI2: IA# 4384
7 ;
8GETTITLE(TIUY,PTDFN,FLAGID) ; RPC Gets Note Title associated with FLAGID for PTDFN
9 ;Receives TIUY by ref; passes back
10 ; TIUY = TitleIEN^Title
11 ; 0 if no title is associated or flg assignmt is not active
12 ;Requires PTDFN
13 ;Requires FLAGID - identifier for particular flag assignment
14 ; for patient PTDFN. Set as subscript in GETACT^DGPFAPI.
15 ; See GETFLG^ORPRF.
16 N PRFARR K TIUY S TIUY=0
17 Q:'$G(PTDFN) Q:'$G(FLAGID)
18 S TIUY=$$GETACT^DGPFAPI(PTDFN,"PRFARR") ;Get ACTive flag info
19 Q:'TIUY
20 S TIUY=$G(PRFARR(FLAGID,"TIUTITLE"))
21 I TIUY'>0 S TIUY=0
22 Q
23 ;
24GETNOTES(TIUY,PTDFN,TIUTTL,REVERSE) ; RPC gets SIGNED, LINKED PRF
25 ;notes titled TIUTTL for patient PTDFN
26 ; Excludes Notes linked to Entered in Error (EIE) actions and
27 ;notes linked to Erroneous actions (actions taken prior to
28 ;EIE actions).
29 ; Receives TIUY by ref; passes back
30 ; TIUY = # of notes
31 ; TIUY([Reverse][Incremented]InternalNoteDate) =
32 ; NoteIEN^ActionName^ExternalNoteDate^AuthorName
33 ; Requires PTDFN,TIUTTL
34 ; Includes status Uncosigned, Completed, & Amended only.
35 ; Optional REVERSE - Boolean Flag:
36 ; 1 - Sort notes by reverse chronological order
37 ; 0 (default) - Sort notes by chronological order
38 N TIUDG,ACTID,TIUIDATE,TIUEDATE,TIUIEN,TIUACT,STATUS
39 N TIUAUTH,DTARRAY,HASERR,ARRAYNM
40 K TIUY ; Initialize array in case caller hasn't done so.
41 S (TIUY,ACTID)=0
42 ; -- Get Assgn Hist info (GETHTIU initializes array
43 ; so we don't need to):
44 S ARRAYNM="^TMP(""TIUPRFH"",$J)"
45 S TIUDG=$$GETHTIU^DGPFAPI1(PTDFN,TIUTTL,ARRAYNM)
46 G:'TIUDG GETNOTEX
47 S HASERR=$$HASERR^TIUPRFL(ARRAYNM)
48 F S ACTID=$O(@ARRAYNM@("HISTORY",ACTID)) Q:'ACTID D
49 . I ACTID=+HASERR Q ;Entered in Error
50 . I HASERR>0,$$ISERR^TIUPRFL(ARRAYNM,ACTID,$P(HASERR,U,2)) Q ;erroneous
51 . S TIUIEN=+@ARRAYNM@("HISTORY",ACTID,"TIUIEN")
52 . Q:TIUIEN'>0 ;TMP node may be just ^
53 . ; -- Include only complete or amended or uncosigned notes:
54 . S STATUS=$P($G(^TIU(8925,TIUIEN,0)),U,5) I '((STATUS=6)!(STATUS=7)!(STATUS=8)) Q
55 . S TIUACT=$P(@ARRAYNM@("HISTORY",ACTID,"ACTION"),U,2)
56 . N TIUFLDS,TIUERR D GETS^DIQ(8925,TIUIEN_",","1202;1301","IE","TIUFLDS","TIUERR")
57 . S TIUIDATE=TIUFLDS(8925,TIUIEN_",",1301,"I")
58 . ; -- Increment date if there are multiple notes w/ same exact date:
59 . F S:$D(DTARRAY(TIUIDATE)) TIUIDATE=TIUIDATE+.0000001 I '$D(DTARRAY(TIUIDATE)) S DTARRAY(TIUIDATE)="" Q
60 . I $G(REVERSE) S TIUIDATE=9999999-TIUIDATE
61 . S TIUEDATE=$E(TIUFLDS(8925,TIUIEN_",",1301,"E"),1,18)
62 . I TIUEDATE="" S TIUEDATE="No Ref Date"
63 . S TIUAUTH=TIUFLDS(8925,TIUIEN_",",1202,"E")
64 . I TIUAUTH="" S TIUAUTH="No Author"
65 . S TIUY=TIUY+1
66 . S TIUY(TIUIDATE)=TIUIEN_U_TIUACT_U_TIUEDATE_U_TIUAUTH
67GETNOTEX ;
68 K ^TMP("TIUPRFH",$J)
69 Q
70 ;
71GETACTS(TIUY,TIUTTL,DFN) ;RPC Gets PRF Action info
72 ;"Action" is shorthand for Assignment History entry
73 ;Returns data in the following format for each Action:
74 ;TIUY(ACTID) =
75 ; FLAGNAME^ASSGNIEN^ACTIONNAME^ACTIONIEN^ACTIONDATEI^ACTIONDATEE^TIUIEN
76 ; where Integer ACTID = subscript after "HISTORY" in array returned
77 ; by GETHTIU^DGPFAPI1
78 ;Returns linkable actions (whether linked or not) for Patient DFN
79 ; and flag assoc w/ TIUTTL.
80 ;Excludes UNLINKABLE actions = Entered in Error actions (EIE) or
81 ; actions taken prior to an EIE action.
82 ;Erroneous and EIE actions may be for the wrong patient, etc.
83 N TIUDG,ACTID,TIUFLAG,UNLINKBL,ARRAYNM
84 S TIUY=1,ARRAYNM="^TMP(""TIUPRFH"",$J)"
85 S TIUDG=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM)
86 I 'TIUDG S TIUY="0^"_$P(TIUDG,U,2) G GETACTX
87 ; -- If no unlinked, linkable actions exist, say so but go on:
88 I '$$AVAILACT^TIUPRFL("^TMP(""TIUPRFH"",$J)",,.UNLINKBL) S TIUY="0^All linkable Flag actions are already linked"
89 ; -- Return ALL linkable actions (linked or not):
90 S TIUFLAG=$P(^TMP("TIUPRFH",$J,"FLAG"),U,2)_U_$P(^TMP("TIUPRFH",$J,"ASSIGNIEN"),U)
91 S ACTID=0
92 F S ACTID=$O(^TMP("TIUPRFH",$J,"HISTORY",ACTID)) Q:'+ACTID D
93 . Q:$G(UNLINKBL(ACTID))
94 . S TIUY(ACTID)=TIUFLAG
95 . S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"ACTION"),U,2)
96 . S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"HISTIEN"),U,1)
97 . S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"DATETIME"),U,1)
98 . S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"DATETIME"),U,2)
99 . S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"TIUIEN"),U,1)
100GETACTX ;
101 K ^TMP("TIUPRFH",$J)
102 Q
103 ;
104LINK(TIUY,TIUIEN,ASSGNDA,ACTIEN,DFN) ;RPC Link TIU Doc TIUIEN to
105 ; the PRF action
106 N TIUTTL
107 S TIUTTL=+$G(^TIU(8925,TIUIEN,0))
108 I 'TIUTTL S TIUY="0^Document does not exist" Q
109 ; Remove any links before making new link
110 D UNLINK^TIUPRF1(TIUIEN)
111 S TIUY=$$STOTIU^DGPFAPI2(DFN,ASSGNDA,ACTIEN,TIUIEN)
112 Q
113GETSTAT(TIUY,TIUIEN) ;RPC Gets the status of TIU Doc TIUIEN
114 ;Returns STATIEN^STATNAME
115 N TIUTTL
116 S TIUTTL=+$G(^TIU(8925,TIUIEN,0))
117 I 'TIUTTL S TIUY="0^Document does not exist" Q
118 S TIUY=$P(^TIU(8925,TIUIEN,0),U,5)
119 S TIUY=TIUY_U_$P($G(^TIU(8925.6,TIUY,0)),U,1)
120 Q
121ISPRFTTL(TIUY,TIUDA) ;RPC Takes as input 8925.1 IEN
122 ; and checks if it is a PRF title
123 ; Cf ISPFTTL^TIUPRFL. which is a FUNCTION
124 N TIUCAT1,TIUCAT2,TIUD1
125 S TIUY=0,TIUD1=""
126 S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
127 S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
128 S TIUD1=$O(^TIU(8925.1,"AD",TIUDA,TIUD1))
129 I TIUD1=TIUCAT1!(TIUD1=TIUCAT2) S TIUY=1
130 Q
Note: See TracBrowser for help on using the repository browser.