source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULRR.m@ 839

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1TIULRR ; SLC/JM - Restricted Record Library functions ;7/17/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**58,121**;Jun 20, 1997
3 ;
4 Q
5 ;
6INITRR(ASKONCE) ; Initializes Restricted Record List
7 ; If ASKONCE is true, calls to PTRES will only ask once for any given
8 ; patient. If they answer no it will not ask again. If ASKONCE is
9 ; false, it will continue to ask on the same patient until they
10 ; answer Yes (used when called from list manager)
11 N MSG
12 S MSG=$S('($D(DUZ)#2):"user code",'$D(^VA(200,DUZ,0)):"user name",1:"")
13 I MSG'="" D Q
14 .K TIURRECL
15 .I $D(VALMAR) D FULL^VALM1
16 .W !!?2,"Your ",MSG," is undefined. This must be defined to access"
17 .W !?2,"patient information.",!
18 I $G(TIURRECL("DUZ"))'=DUZ D ;DUZ has changed - start over
19 .K TIURRECL
20 .S TIURRECL("DUZ")=DUZ
21 S TIURRECL("RCNT")=+$G(TIURRECL("RCNT"))+1
22 I TIURRECL("RCNT")=1 D ; First reference call
23 .S TIURRECL=0
24 .I +$G(ASKONCE) S TIURRECL("ONCE")="X"
25 Q
26 ;
27KILLRR ; Kills the Restricted Record List
28 I '$D(TIURRECL) Q
29 S TIURRECL("RCNT")=+$G(TIURRECL("RCNT"))-1
30 I +TIURRECL("RCNT")<1 K TIURRECL
31 Q
32 ;
33DOCRES(TIUDA) ; Evaluate Restricted Record for a specific Document
34 N TIUY,TIUD0 S TIUY=0
35 S TIUD0=$G(^TIU(8925,TIUDA,0)) G:+$P(TIUD0,U,2)'>0 DOCRESX
36 S TIUY=$$PTRES(+$P(TIUD0,U,2))
37DOCRESX Q TIUY
38PTRES(DFN) ; Returns TRUE if patient is restricted
39 I '$D(TIURRECL) Q 0 ; Does not function if INITRR has not been called
40 N TIUBAD
41 S TIUBAD=0
42 I +$$GET1^DIQ(38.1,+$G(DFN),2,"I") D
43 .N DOCHECK
44 .S TIUBAD=1,DOCHECK=1
45 .I TIURRECL>0 D
46 ..N I,IDX,SRCH,DONE
47 ..S SRCH=U_DFN_"=",DONE=0
48 ..F I=1:1:TIURRECL D Q:DONE
49 ...S IDX=$F(TIURRECL(I),SRCH)
50 ...I IDX D
51 ....S DONE=1,DOCHECK=0
52 ....I $D(TIURRECL("ONCE")) S TIUBAD=+$E(TIURRECL(I),IDX)
53 ....E S TIUBAD=0
54 .I DOCHECK D
55 ..I $D(VALMAR) D FULL^VALM1
56 ..N Y,DTOUT,DUOUT,DOADD
57 ..S Y=$$CHECK(DFN)
58 ..I ($D(DTOUT))!($D(DUOUT)) S DOADD=0
59 ..E D
60 ...I Y'=-1 S TIUBAD=0
61 ...S DOADD=(Y'=-1)!($D(TIURRECL("ONCE")))
62 ..I DOADD D
63 ...N ADD
64 ...S ADD=0
65 ...I TIURRECL=0 S ADD=1
66 ...E I $L(TIURRECL(TIURRECL))>200 S ADD=1
67 ...I ADD S TIURRECL=TIURRECL+1,TIURRECL(TIURRECL)=U
68 ...S TIURRECL(TIURRECL)=TIURRECL(TIURRECL)_DFN_"="_TIUBAD_U
69 Q TIUBAD
70DOCCHK(TIUDA) ; Wrap CHECK
71 Q +$$CHECK($P($G(^TIU(8925,TIUDA,0)),U,2))
72CHECK(DFN) ; call ^DIC to execute check
73 N DIC,X,Y
74 S DIC=2,X="`"_DFN,DIC(0)="E"
75 W !! D ^DIC
76 Q Y
Note: See TracBrowser for help on using the repository browser.