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

TIUPRF1.m

Go to the documentation of this file. 
  1. TIUPRF1 ; SLC/JMH - Modules for Patient Record Flags ; 1/9/06
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
  1.  ;
  1. SELECT(TIUTTL,DFN,TIUDA) ; Select flag action for VISTA
  1.  ;Requires:
  1.  ;   TIUTTL - 8925.1 IEN
  1.  ;   DFN - Patient IEN
  1.  ;Optional:
  1.  ;   TIUDA - Note IEN: If user picks the link that TIUDA is already
  1.  ;                     linked to, question the pick
  1.  ;Returns:
  1.  ;   PRFAssignmentIEN^PRFAssignmentHistoryIEN or
  1.  ;   0^msg         ;
  1.  ; LINEOK = Line of action selected by user
  1.  ; TIUAGN = 2 if note TIUDA is already linked to selected action
  1.  ; TIUAGN = 1 if Assignment History IEN selected by user already has
  1.  ;              another note linked to it
  1.  N TIUDG,TIUER,TIURET,TIUAGN,LKBLARR
  1.  N FLAGNM,HASFLAG,AVAIL,LINKBL,UNLINKBL,TIUJ
  1.  S TIUAGN=0,HASFLAG=1
  1.  S FLAGNM=$$FNDFLAG^TIUPRFL(TIUTTL)
  1.  I 'FLAGNM S HASFLAG=0
  1.  S FLAGNM=$S(HASFLAG:$P(FLAGNM,U,2),1:"UNKNOWN")
  1.  S TIUDG=$$GETHTIU^DGPFAPI1(DFN,+$G(TIUTTL),"^TMP(""TIUPRFH"",$J)")
  1.  F  D  Q:'TIUAGN
  1.  . I 'TIUAGN W !!,"This Note must be linked to Patient Record Flag:",!,"        ",FLAGNM,!,"  Checking for available Flag Actions...",!
  1.  . I 'TIUDG S TIURET="0^"_$P(TIUDG,U,2) D  Q
  1.  . . W !,$P(TIUDG,U,2),"!",!
  1.  . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1.  . S AVAIL=$$AVAILACT^TIUPRFL("^TMP(""TIUPRFH"",$J)",.LINKBL,.UNLINKBL)
  1.  . I 'AVAIL D  Q
  1.  . . S TIURET="0^All linked"
  1.  . . W !,"All linkable Flag actions for this Patient and Title are already linked!",!
  1.  . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1.  . I TIUAGN=1 W "  ?? This action already has a note linked to it.",! S TIUAGN=0
  1.  . I TIUAGN=2 W "  ?? The note is already linked to this action.",! S TIUAGN=0
  1.  . ; -- If flag assgnmt array has unlinkable actions, omit them and set
  1.  . ;    a new arr starting subscript at 1:
  1.  . I UNLINKBL D  S LKBLARR="^TMP(""TIUPRFLKBL"",$J)"
  1.  . . F TIUJ=1:1:LINKBL M ^TMP("TIUPRFLKBL",$J,"HISTORY",TIUJ)=^TMP("TIUPRFH",$J,"HISTORY",TIUJ+UNLINKBL)
  1.  . I 'UNLINKBL S LKBLARR="^TMP(""TIUPRFH"",$J)"
  1.  . ; Display all linkable actions and prompt user to select one:
  1.  . W !,"Please select a Patient Record Flag Assignment Action: "
  1.  . W !,?7,"Date",?27,"Action",?52,"Note"
  1.  . S (TIUER,LINEOK)=0
  1.  . ; -- Display the flag actions and ask for choice in BREAK
  1.  . F LINENO=1:1:LINKBL D  Q:+TIUER!+LINEOK
  1.  . . D WRITE(LINENO) I '(LINENO#5) D BREAK(LINENO,LINKBL,.TIUER,.LINEOK)
  1.  . I LINENO#5 D BREAK(LINENO,LINKBL,.TIUER,.LINEOK)
  1.  . ; -- Check if user ^ out
  1.  . I TIUER S TIURET="0^USER EXITED" Q
  1.  . S TIURET=+^TMP("TIUPRFH",$J,"ASSIGNIEN")_U_+@LKBLARR@("HISTORY",LINEOK,"HISTIEN")
  1.  . ; -- If action already has a note linked to it, try again:
  1.  . I +$G(TIUDA),+@LKBLARR@("HISTORY",LINEOK,"TIUIEN")=$G(TIUDA) S TIUAGN=2 Q
  1.  . I @LKBLARR@("HISTORY",LINEOK,"TIUIEN") S TIUAGN=1 Q
  1. SELECTQ K ^TMP("TIUPRFH",$J),^TMP("TIUPRFLKBL",$J)
  1.  Q TIURET
  1.  ;
  1. BREAK(LINENO,LINKBL,TIUER,LINEOK) ; Handle prompting
  1.  N TIUX,MORE
  1.  S MORE=$S(LINKBL>LINENO:1,1:0)
  1. BREAK1 ;
  1.  W !,"CHOOSE 1-",LINENO
  1.  I MORE W !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
  1.  W ": " R TIUX:DTIME
  1.  I $S('$T!(TIUX["^"):1,TIUX=""&'MORE:1,1:0) S TIUER=1 Q
  1.  I TIUX="" Q
  1.  I TIUX'=+TIUX!'$D(@LKBLARR@("HISTORY",+TIUX)) W !!,$C(7),"INVALID RESPONSE",! G BREAK1
  1.  S LINEOK=TIUX
  1.  Q
  1.  ;
  1. WRITE(LINENO) ; write the selectable item
  1.  ; Uses LKBLARR
  1.  N TIUX,TIUIEN,TIUAHIST,REFDT
  1.  S TIUX=$P($G(@LKBLARR@("HISTORY",LINENO,"DATETIME")),U)
  1.  W !,?2,LINENO,">",?7,$$FMTE^XLFDT(TIUX,"2D")
  1.  W ?27,$P(@LKBLARR@("HISTORY",LINENO,"ACTION"),U,2),?52
  1.  S TIUIEN=+@LKBLARR@("HISTORY",LINENO,"TIUIEN")
  1.  S TIUAHIST=+@LKBLARR@("HISTORY",LINENO,"HISTIEN")
  1.  I TIUIEN S REFDT=+$G(^TIU(8925,TIUIEN,13)),REFDT=$$DATE^TIULS(REFDT,"MM/DD/YY HR:MIN") W REFDT
  1.  Q
  1.  ;
  1.  ;for patient DFN.
  1.  ; Returns 1 if successful otherwise 0^"error message"
  1.  N TIUTTL
  1.  S TIUTTL=+$G(^TIU(8925,TIUDA,0))
  1.  I 'TIUTTL Q "0^Document does not exist"
  1.  ; -- GUI doesn't link if we check if TIUDA is PRF note, so don't
  1.  ;I '$$ISPFTTL^TIUPRFL(TIUTTL) Q "0^Can't link non-PRF notes"
  1.  S TIURES=$$STOTIU^DGPFAPI2(DFN,ASSGNDA,ACTDA,TIUDA)
  1.  I 'TIURES Q TIURES
  1.  Q 1
  1.  N TIUTTL
  1.  S TIUTTL=+$G(^TIU(8925,TIUDA,0))
  1.  I 'TIUTTL Q
  1.  S TIURES=$$DELTIU^DGPFAPI2(TIUDA)
  1.  Q
  1.  ; returns 1 if successful otherwise 0^"error message"
  1.  N TIUPRF,TIUTTL,TIUASS,TIUACT,TIURES
  1.  S TIUTTL=+$G(^TIU(8925,TIUDA,0))
  1.  S TIUPRF=$$SELECT(TIUTTL,DFN,TIUDA)
  1.  I '+TIUPRF Q TIUPRF
  1.  S TIUASS=+TIUPRF,TIUACT=$P(TIUPRF,U,2)
  1.  D UNLINK(TIUDA)
  1.  S TIURES=$$LINK^TIUPRF1(TIUDA,TIUASS,TIUACT,DFN)
  1.  Q 1
  1.  ;
  1. CHANGE(TIUDA) ; removes old link for TIUDA and links to new PRF assignment for TIUDA's patient
  1.  N DFN,TIUTTL,TIUPRF
  1.  S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
  1.  S TIUTTL=+$G(^TIU(8925,TIUDA,0))
  1.  S TIUPRF=$$SELECT(TIUTTL,DFN,TIUDA)
  1.  I '+TIUPRF W !,"You must select an action ... Nothing (re)-linked." S TIUPOP=1 Q
  1.  S TIUASS=+TIUPRF,TIUACT=$P(TIUPRF,U,2)
  1.  D UNLINK(TIUDA)
  1.  S TIUPRF=$$LINK(TIUDA,TIUASS,TIUACT,DFN)
  1.  I '+TIUPRF S TIUPOP=1 Q
  1.  Q
  1.  ;
  1. PRFCT(TIUOTTL,TIUNTTL,TIUDA) ; handles changing title situations for PRF notes in LM
  1.  N NEWISPRF,DFN,TIULINK,TIULINKC,OLDISPRF
  1.  S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
  1.  S NEWISPRF=$$ISPFTTL^TIUPRFL(TIUNTTL)
  1.  S OLDISPRF=$$ISPFTTL^TIUPRFL(TIUOTTL)
  1.  ;-- non PRF title to PRF title
  1.  I NEWISPRF,'OLDISPRF D  Q
  1.  . W !,"The Title you selected is a PRF Title."
  1.  . W !,"  PRF Notes must be linked to Patient Record Flags.",!
  1.  . W !,"Do you want to continue with this Change Title Action?"
  1.  . I +$$READ^TIUU("YO",,"N")'>0 S TIUQUIT=1 W !,"Title not changed." Q
  1.  . S TIULINK=$$SELECT^TIUPRF1(TIUNTTL,DFN)
  1.  . I 'TIULINK S TIUQUIT=1 W !,"Title not changed." Q
  1.  . ; -- get new link
  1.  . S TIULINKC=$$LINK^TIUPRF1(TIUDA,+TIULINK,$P(TIULINK,U,2),DFN)
  1.  ;-- PRF title to PRF title
  1.  I NEWISPRF,OLDISPRF D  Q
  1.  . W !,"This document is already attached to a Patient Record"
  1.  . W !,"  Flag. It will be unlinked from the current flag"
  1.  . W !,"  and linked to a new flag.",!
  1.  . W !,"Do you want to continue with this Change Title Action?"
  1.  . I +$$READ^TIUU("YO",,"N")'>0 S TIUQUIT=1 W !,"Title not changed." Q
  1.  . ; -- get new PRF Assignment to link to
  1.  . S TIULINK=$$SELECT^TIUPRF1(TIUNTTL,DFN)
  1.  . I 'TIULINK S TIUQUIT=1 W !,"Title not changed." Q
  1.  . D UNLINK^TIUPRF1(+TIUDA)
  1.  . S TIULINKC=$$LINK^TIUPRF1(TIUDA,+TIULINK,$P(TIULINK,U,2),DFN)
  1.  ; -- PRF title to non PRF title
  1.  I 'NEWISPRF,OLDISPRF D  Q
  1.  . W !,"The Title you selected is not a PRF Title."
  1.  . W !,"  The note is currently linked to a Patient Record Flag,"
  1.  . W !,"  but will be unlinked when the title is changed"
  1.  . W !,"  to a non-PRF Title.",!
  1.  . W !,"Do you want to continue with this Change Title Action?"
  1.  . I +$$READ^TIUU("YO",,"N")'>0 S TIUQUIT=1 W !,"Title not changed." Q
  1.  . D UNLINK^TIUPRF1(+TIUDA)
  1.  Q
  1.  ;
  1.  N TIUPRF,TIUPRFL
  1.  S TIUPRF=$$SELECT^TIUPRF1(TIUTYP,DFN)
  1.  I 'TIUPRF W !,"Patient Record Flag Notes must be linked to Flag Actions.",! Q 0
  1.  S TIUPRFL=$$LINK^TIUPRF1(TIUDA,$P(TIUPRF,U,1),$P(TIUPRF,U,2),DFN)
  1.  I 'TIUPRFL W !,$P(TIUPRFL,U,2),! Q 0
  1.  Q 1