source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRFL.m@ 902

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1TIUPRFL ; SLC/JMH - Library Functions for Patient Record Flags ;1/26/06
2 ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
3 ;
4 ;External References
5 ;IA #4383
6 ;$$FNDTITLE^DGPFAPI1
7 ;$$GETHTIU^DGPFAPI1
8 ;$$GETLINK^DGPFAPI1
9AVAILACT(ARRAYNM,LINKBL,UNLINKBL,ONEIEN) ;Returns the # of unlinked,
10 ;linkable actions.
11 ; Note: Entered in Error (EIE) actions are not linkable,
12 ;nor actions taken BEFORE an EIE action.
13 ; ARRAYNM - Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM)
14 ; has just been called for given flag title
15 ; and given patient.
16 ; LINKBL - optional, passed by ref, returns
17 ; # of linkable actions in array ARRAYNM
18 ; UNLINKBL - optional array, passed by ref, returns
19 ; UNLINKBL - # of unlinkable actions in ARRAYNM
20 ; UNLINKBL(ActID)=1, for each unlinkable action,
21 ; where ActID is action subscript in ARRAYNM
22 ; ONEIEN - optional, passed by ref, returns
23 ; the action IEN (NOT subscript) if there is
24 ; exactly one available action
25 ; AVAIL - Return value of function, returns
26 ; # of unlinked, linkable actions in ARRAYNM
27 N ACTID,AVAIL,HASERR,ACTIEN
28 S (ACTID,AVAIL,ONEIEN,LINKBL,UNLINKBL)=0
29 S HASERR=$$HASERR(ARRAYNM)
30 F S ACTID=$O(@ARRAYNM@("HISTORY",ACTID)) Q:'ACTID D
31 . ; -- Set UNLINKBL whether linked or not:
32 . I ACTID=+HASERR S UNLINKBL(ACTID)=1,UNLINKBL=UNLINKBL+1 Q
33 . I $G(HASERR),$$ISERR(ARRAYNM,ACTID,$P(HASERR,U,2)) S UNLINKBL(ACTID)=1,UNLINKBL=UNLINKBL+1 Q
34 . ; -- If not unlinkable, set LINKBL & check if already linked:
35 . S LINKBL=LINKBL+1
36 . I $G(@ARRAYNM@("HISTORY",ACTID,"TIUIEN")) Q
37 . S AVAIL=AVAIL+1
38 . S ACTIEN=+$G(@ARRAYNM@("HISTORY",ACTID,"HISTIEN"))
39 I AVAIL=1,$G(ACTIEN)>0 S ONEIEN=ACTIEN
40 Q AVAIL
41 ;
42ISPFTTL(TITLEDA) ; FUNCTION returns 1 if TITLEDA
43 ;is PRF Title, otherwise returns 0
44 ;Note ISPFTTL is spelled with PF, NOT PRF
45 ; Cf RPC ISPRFTTL^TIUPRF2 - spelled with PRF
46 N TIUCAT1,TIUCAT2,TIUDADDA
47 S TIUDADDA=""
48 S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
49 S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
50 S TIUDADDA=$O(^TIU(8925.1,"AD",TITLEDA,TIUDADDA))
51 I TIUDADDA=TIUCAT1!(TIUDADDA=TIUCAT2) Q 1
52 Q 0
53 ;
54ISPFDC(DCLASSDA) ; FUNCTION returns 1 if DCLASSDA
55 ;is PRF Document Class, otherwise returns 0
56 ; Requires valid IEN in 8925.1
57 N TIUCAT1,TIUCAT2
58 S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
59 S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
60 I (DCLASSDA=TIUCAT1)!(DCLASSDA=TIUCAT2) Q 1
61 Q 0
62 ;
63FNDACTIF(TIUDA) ;Find Action Info for Note TIUDA
64 ;Returns AssignIEN^ActionIEN^ActionNumber or
65 ;0^"error message" if not linked, where
66 ; Action IEN is Assignment History IEN and
67 ; Action ID is node from GETHTIU^DGPFAPI1 array
68 ; Note: for Action IEN ONLY, use $$GETLINK^DGPFAPI1(TIUDA)
69 N ACTID,TIUTTL,TIURET,DFN
70 S ACTID=0,TIURET=0
71 S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
72 S TIUTTL=+$G(^TIU(8925,TIUDA,0))
73 S TIURET=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,"^TMP(""TIUPRF"",$J)")
74 I '+TIURET Q TIURET
75 F S ACTID=$O(^TMP("TIUPRF",$J,"HISTORY",ACTID)) Q:'ACTID D
76 . I +$G(^TMP("TIUPRF",$J,"HISTORY",ACTID,"TIUIEN"))=TIUDA D
77 . . S TIURET=+^TMP("TIUPRF",$J,"ASSIGNIEN")_U_+^TMP("TIUPRF",$J,"HISTORY",ACTID,"HISTIEN")_U_ACTID
78 K ^TMP("TIUPRF",$J)
79 Q TIURET
80 ;
81FNDFLAG(TIUTITLE) ; Find Associated Flag IEN for Title
82 ;Function returns VarPTRFlagIEN^FlagName or
83 ;0^msg
84 ;from Flag file 26.15 (National) or 26.11 (Local)
85 ;Example: 1;DGPF(26.15,^BEHAVIORAL]
86 I '$L($T(FNDTITLE^DGPFAPI1)) Q "?"
87 Q $$FNDTITLE^DGPFAPI1(TIUTITLE)
88 ;
89CFLDFLAG(TIUTITLE) ; Code for computed field PRFFLAG in file 8925.1
90 ; Returns FlagName from file 26.11 or 26.15 for flag associated
91 ;with TIUTITLE
92 ; Returns ? if no flag is assoc w/ title or flag cannot be found
93 ; Returns NA if TIUTITLE is not a PRF title
94 ; Requires TITTITLE = 8925.1 IEN
95 N FLAGINFO
96 I '$$ISPFTTL(TIUTITLE) Q "NA"
97 S FLAGINFO=$$FNDFLAG(TIUTITLE)
98 I 'FLAGINFO Q "?"
99 Q $P(FLAGINFO,U,2)
100 ;
101CFLDACT(NOTEDA) ; Code for computed field PRF FLAG ACTION in file 8925
102 ; Returns: Date of Linked Action[space]Name of Action
103 ;for action NOTEDA is linked to.
104 N TIUTTL,LINE,TIULINK,DFN,ACTINFO,TIUDG,ACTID,ACTDATE,ACTNAME,TIUNODE0
105 S TIUNODE0=^TIU(8925,NOTEDA,0),TIUTTL=$P(TIUNODE0,U)
106 S TIULINK=$$GETLINK^DGPFAPI1(NOTEDA)
107 I 'TIULINK,'$$ISPFTTL(TIUTTL) Q "NA"
108 I 'TIULINK Q "?"
109 S DFN=$P(TIUNODE0,U,2)
110 S ACTINFO=$$FNDACTIF^TIUPRFL(NOTEDA)
111 S ACTID=+$P(ACTINFO,U,3)
112 ; -- If not PRF note but has link by mistake, return ? instead of NA:
113 I 'ACTID Q "?" ; Title not linked to flag
114 S TIUDG=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,"^TMP(""TIUPRF"",$J)")
115 S ACTDATE=$P(^TMP("TIUPRF",$J,"HISTORY",ACTID,"DATETIME"),U)
116 S ACTDATE=$$FMTE^XLFDT(ACTDATE,"2D")
117 S ACTNAME=$P(^TMP("TIUPRF",$J,"HISTORY",ACTID,"ACTION"),U,2)
118 S LINE=ACTDATE_" "_ACTNAME
119 K ^TMP("TIUPRF",$J)
120 Q LINE
121 ;
122ISERR(ARRAYNM,ACTID,REACTDTM) ; Is Flag Action erroneous?
123 ; Actions that take place BEFORE an EIE action are ERRONEOUS
124 ;An EIE action itself is NOT erroneous
125 ; Should be called AFTER HASERR, & only if HASERR>0
126 ; Returns: 1 if Action date/time of ACTID is strictly BEFORE
127 ; the Entered in Error date/time
128 ; 0 if = or AFTER the Entered in Error date/time
129 ; -1^msg if error
130 ; Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM) has just been
131 ;called, and array named ARRAYNM currently exists for title
132 ;assoc w/ flag and for given patient.
133 ;Requires ARRAYNM
134 ;Requires ACTID - subscript preceding "ACTION" in above array
135 ;Requires REACTDTM as set in HASERR.
136 N ISERR,ACTDTM S ISERR=0
137 S ACTDTM=$P($G(@ARRAYNM@("HISTORY",ACTID,"DATETIME")),U)
138 I ACTDTM'>0 S ISERR="-1^Can't tell whether action is erroneous" G ISERRX
139 I $G(REACTDTM)'>0 S ISERR="-1^Can't tell whether action is erroneous" G ISERRX
140 I ACTDTM<REACTDTM S ISERR=1
141ISERRX Q ISERR
142 ;
143HASERR(ARRAYNM) ; Function indicates that given flag assignmt
144 ;for given patient has ERRONEOUS actions.
145 ; ERRONEOUS ACTIONS: all actions taken BEFORE
146 ;an ENTERED IN ERROR (EIE) action
147 ; Note: HASERR is equivalent to Has an EIE Action (HASEIE):
148 ;(HASERR implies HASEIE. and HASEIE implies HASERR since
149 ;EIE action always has actions taken previously.)
150 ; Returns: EIEActionID^EIEDateTime if flag assignmt has been
151 ; marked Entered in Error (EIE). If there are multiple
152 ; EIE actions, returns the most RECENT.
153 ; 0 if assignmt not marked EIE
154 ; -1^msg if error
155 ; Actions and notes for Erroneous actions or EIE actions
156 ;should not be displayed in OR/TIU flag-related displays.
157 ; Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM) has just been
158 ;called, and array named ARRAYNM currently exists for title
159 ;assoc w/ flag and for given patient.
160 N ACTID,HASERR
161 I '$D(@ARRAYNM@("HISTORY")) S HASERR="-1^Can't tell whether flag assignment has erroneous actions" G HASERRX
162 S ACTID=1000000,HASERR=0
163 F S ACTID=$O(@ARRAYNM@("HISTORY",ACTID),-1) G:'+ACTID HASERRX D G:HASERR HASERRX
164 . I $P(@ARRAYNM@("HISTORY",ACTID,"ACTION"),U,2)="ENTERED IN ERROR" D
165 . . S HASERR=ACTID_U_$P(@ARRAYNM@("HISTORY",ACTID,"DATETIME"),U)
166HASERRX Q HASERR
Note: See TracBrowser for help on using the repository browser.