| [613] | 1 | TIULRR ; SLC/JM - Restricted Record Library functions ;7/17/01
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**58,121**;Jun 20, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | INITRR(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 | ;
|
|---|
| 27 | KILLRR ; 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 | ;
|
|---|
| 33 | DOCRES(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))
|
|---|
| 37 | DOCRESX Q TIUY
|
|---|
| 38 | PTRES(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
|
|---|
| 70 | DOCCHK(TIUDA) ; Wrap CHECK
|
|---|
| 71 | Q +$$CHECK($P($G(^TIU(8925,TIUDA,0)),U,2))
|
|---|
| 72 | CHECK(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
|
|---|
