164 lines
6.7 KiB
Mathematica
164 lines
6.7 KiB
Mathematica
TIUCNSLT ; SLC/JER - Patient movement look-up ;1/7/03 [6/11/04 8:34am]
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**4,31,109,131,142,144,184**;Jun 20, 1997
|
|
; External References
|
|
; DBIA 2324 $$ISA^USRLM
|
|
; DBIA 3473 SEND^GMRCTIU
|
|
; DBIA 3473 GET^GMRCTIU
|
|
; DBIA 3575 ROLLBACK^GMRCTIU1
|
|
GETCNSLT(DFN,TIUCPF,TIUDA,TIUOVR) ; Match consult result
|
|
;to an active request
|
|
; Call with:
|
|
; [DFN] - patient file entry number
|
|
; [TIUCPF] - flag to indicate clinical procedure (Optional)
|
|
; [TIUDA] - TIU document IEN of consult result (Optional).
|
|
; If TIUDA has a request, return it w/o asking user.
|
|
; [TIUOVR] - flag to override restrictions on selectable requests
|
|
; (Optional). If not received or received as null, reset
|
|
; according to whether user is in MIS.
|
|
; Note - If DA is defined and TIU document DA has a request,
|
|
; code returns its request instead of asking user.
|
|
; Returns: TIUY - Variable pointer to consult request
|
|
; = -1 if pat has no requests
|
|
; = 0 if no request is selected
|
|
AGN ; Loop for handling repeated attempts
|
|
N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUCNT,X
|
|
I +DFN'>0 S TIUOUT=1 Q 0
|
|
I +$G(GMRCO) S TIUX=+$G(GMRCO) G GETX
|
|
; -- If TIUDA is not defined, try DA for backward
|
|
; compatibility:
|
|
S TIUDA=$S('$D(TIUDA):+$G(DA),1:+TIUDA)
|
|
; -- Ignore TIUDA if it doesn't match pt DFN:
|
|
I $P($G(^TIU(8925,TIUDA,0)),U,2)'=+DFN S TIUDA=0
|
|
; -- If TIUDA or its parent already has a request,
|
|
; return it & don't ask user:
|
|
I +$P($G(^TIU(8925,TIUDA,14)),U,5) S TIUX=+$P($G(^(14)),U,5) G GETX
|
|
I +$$ISADDNDM^TIULC1(TIUDA) S TIUX=+$$DADCR(TIUDA) G:+TIUX>0 GETX
|
|
; -- If override flag is null or is not defined, set it according to
|
|
; user's membership in MIS:
|
|
S TIUOVR=$S($G(TIUOVR)="":+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION"),1:+TIUOVR)
|
|
D SEND^GMRCTIU(DFN,$G(TIUOVR),$G(TIUCPF))
|
|
; If no consult requests for patient, then quit with -1
|
|
I $S($G(^TMP("GMRCR",$J,"TIU",1,0))["No Consults":1,'$D(^TMP("GMRCR",$J,"TIU")):1,1:0) D Q -1
|
|
. W !!,$C(7),"No CONSULT REQUESTS to Result for ",$P($G(^DPT(DFN,0)),U),".",!
|
|
S (TIUCNT,TIUI)=0 F S TIUI=+$O(^TMP("GMRCR",$J,"TIU",TIUI)) Q:+TIUI'>0 D
|
|
. S TIUCNT=+$G(TIUCNT)+1
|
|
W !,"You must link this Result to a Consult Request...",!
|
|
D I +TIUER Q:+$G(TIUOUT) 0 G AGN
|
|
. W !,"The following CONSULT REQUEST"
|
|
. W $S(+TIUCNT>1:"(S) are",1:" is")," available:"
|
|
. S (TIUER,TIUOK,TIUI)=0
|
|
. F S TIUI=$O(^TMP("GMRCR",$J,"TIU",TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
|
|
. . S TIUII=TIUI,TIUX=$G(^TMP("GMRCR",$J,"TIU",TIUI,0))
|
|
. . D WRITE I '(TIUI#5) D BREAK
|
|
. Q:$D(TIUOUT)
|
|
. I +TIUER S TIUOUT=1 Q
|
|
. I TIUII#5 D BREAK Q:$D(TIUOUT)
|
|
. I +TIUER S TIUOUT=1 Q
|
|
. S TIUX=$O(^TMP("GMRCR",$J,"TIU","B",+TIUOK,0))
|
|
. ;,^DISV(DUZ,"^GMR(123,",DFN)=+TIUX
|
|
. W " ",+TIUX
|
|
GETX S TIUY=+TIUX_";GMR(123,"
|
|
Q $G(TIUY)
|
|
BREAK ; Handle prompting
|
|
W !,"CHOOSE 1-",TIUII W:$D(^TMP("GMRCR",$J,"TIU",TIUII+1,0)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
|
|
I $S('$T!(X["^"):1,X=""&'$D(^TMP("GMRCR",$J,"TIU",TIUII+1)):1,1:0) S TIUER=1 Q
|
|
I X="" Q
|
|
I X'=+X!'$D(^TMP("GMRCR",$J,"TIU",+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
|
|
S TIUOK=X
|
|
Q
|
|
DADCR(DA) ; Get the Consult request associated with the parent record
|
|
N TIUDADA,TIUY S TIUDADA=$P($G(^TIU(8925,+DA,0)),U,6)
|
|
S TIUY=$P($G(^TIU(8925,TIUDADA,14)),U,5)
|
|
Q TIUY
|
|
WRITE W !,TIUX
|
|
Q
|
|
POST(TIUDA,STATUS) ; Post status updates to Consult Tracking
|
|
N GMRCDA,DA,TIUAUTH S GMRCDA=+$P($G(^TIU(8925,+TIUDA,14)),U,5)
|
|
I +GMRCDA'>0 Q
|
|
S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
|
|
D GET^GMRCTIU(GMRCDA,TIUDA,STATUS,TIUAUTH)
|
|
Q
|
|
ISCNSLT(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a CONSULT
|
|
N TIUCLASS
|
|
S TIUCLASS=+$$CLASS
|
|
I +TIUCLASS'>0 S TIUY=0 Q
|
|
S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
|
|
Q
|
|
CHANGE(TIUDA,TIUCPF,TIUNOCS) ; Re-direct the TIU Document to a different CT Record
|
|
; Passes back TIUNOCS=-1 if pt has no requests or none is selected
|
|
N DA,DFN,DIE,DR,GMRCO,GMRCSTAT,GMRCVP,TIUD0,TIUD14
|
|
S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD14=$G(^(14))
|
|
S DFN=$P(TIUD0,U,2),GMRCO=$P(TIUD14,U,5)
|
|
Q:+DFN'>0
|
|
I GMRCO'="" D ROLLBACK(TIUDA) K GMRCO ;P144
|
|
CHAGN S DA=TIUDA,TIUNOCS=0
|
|
W ! S GMRCVP=+$$GETCNSLT(DFN,$G(TIUCPF))_";GMR(123,"
|
|
I +GMRCVP=0 W !!,$C(7),"You must select a Consult Request...Restoring record."
|
|
I +GMRCVP'>0 D RETREAT(TIUDA,TIUD14) S TIUPOP=1,TIUNOCS=-1 Q ;P144
|
|
S DIE=8925,DA=TIUDA,DR="1405////^S X=GMRCVP" D ^DIE
|
|
D UPDTADD(TIUDA,GMRCVP)
|
|
S GMRCO=+GMRCVP,GMRCSTAT=$S($P(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
|
|
D POST(TIUDA,GMRCSTAT)
|
|
Q
|
|
RETREAT(DA,TIUD14) ; If Pt has no requests, retreat gracefully
|
|
N DIE,DR,GMRCO,GMRCSTAT
|
|
S DIE=8925,DR="1405////^S X=$P(TIUD14,U,5)" D ^DIE
|
|
S GMRCO=+$P(TIUD14,U,5)
|
|
S GMRCSTAT=$S($P(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
|
|
D POST(TIUDA,GMRCSTAT)
|
|
Q
|
|
UPDTADD(TIUDA,TIUCVP) ; Addenda for re-linked original are updated
|
|
;Update TIU(8925 ONLY. GMR(123 doesn't track individual adda
|
|
I $$HASADDEN^TIULC1(+TIUDA) D
|
|
. N DA
|
|
. S DA=0 F S DA=$O(^TIU(8925,"DAD",+TIUDA,DA)) Q:+DA'>0 D
|
|
. . N DR,DIE
|
|
. . I '+$$ISADDNDM^TIULC1(+DA) Q
|
|
. . S DR="1405////^S X=TIUCVP"
|
|
. . S DIE=8925 D ^DIE
|
|
. . D ^DIE
|
|
Q
|
|
ROLLBACK(TIUDA) ; Roll back CT Record when TIU changes require it
|
|
N GMRCDA,DIE,DR,DA S GMRCDA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
|
|
I +GMRCDA>0 D ROLLBACK^GMRCTIU1(GMRCDA,TIUDA) ;P144
|
|
S DIE="^TIU(8925,",DA=TIUDA,DR="1405///@" D ^DIE
|
|
Q
|
|
CLASS() ; What is the TIU Class (or Document Class) for CONSULTS
|
|
N GMRCY
|
|
S GMRCY=+$O(^TIU(8925.1,"B","CONSULTS",0))
|
|
I +GMRCY>0,$S($P($G(^TIU(8925.1,+GMRCY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S GMRCY=0
|
|
Q GMRCY
|
|
REMCNSLT(TIUDA) ;Remove link to consult if there is one ;*171
|
|
;TIUDA is a TIU record number
|
|
N TIUTYPE,TIUDELX
|
|
S TIUTYPE=+$G(^TIU(8925,+TIUDA,0))
|
|
S TIUDELX=$$DELETE^TIULC1(TIUTYPE)
|
|
I TIUDELX]"" X TIUDELX
|
|
Q
|
|
CONSCT(TIUDA,TIUOTTL,TIUNTTL) ;
|
|
;non cons title to cons title - already handled
|
|
;cons title to cons title - already handled
|
|
;cons title to non cons title
|
|
N TIUCLASS
|
|
S TIUCLASS=$$CLASS^TIUCNSLT()
|
|
I +$$ISA^TIULX(TIUOTTL,TIUCLASS),'+$$ISA^TIULX(TIUNTTL,TIUCLASS) D
|
|
. W !,"The Title you selected is not a Consults Title."
|
|
. W !," The note is currently linked to a Consults Request,"
|
|
. W !," but will be disassociated when the title is changed"
|
|
. W !," to a non Consults Title.",!
|
|
. W !,"Do you want to continue with this Change Title Action?"
|
|
. I +$$READ^TIUU("YO",,"N")'>0 S TIUQUIT=1
|
|
. I $G(TIUQUIT)=1 W !,"Title not changed." Q
|
|
. D REMCNSLT(+TIUDA)
|
|
Q
|
|
CNSCTGUI(TIUDA,TIUOTTL,TIUNTTL) ;
|
|
;non cons title to cons title - already handled
|
|
;cons title to cons title - already handled
|
|
;cons title to non cons title
|
|
N TIUCLASS
|
|
S TIUCLASS=$$CLASS^TIUCNSLT()
|
|
I +$$ISA^TIULX(TIUOTTL,TIUCLASS),'+$$ISA^TIULX(TIUNTTL,TIUCLASS) D
|
|
. ;Assume the confirmation has been taken care of already
|
|
. D REMCNSLT(+TIUDA)
|
|
Q
|