Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUCNSLT

TIUCNSLT.m

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