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

TIUPRFL.m

Go to the documentation of this file. 
  1. TIUPRFL ; SLC/JMH - Library Functions for Patient Record Flags ;1/26/06
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
  1.  ;
  1.  ;External References
  1.  ;IA #4383
  1.  ;$$FNDTITLE^DGPFAPI1
  1.  ;$$GETHTIU^DGPFAPI1
  1.  ;$$GETLINK^DGPFAPI1
  1. AVAILACT(ARRAYNM,LINKBL,UNLINKBL,ONEIEN) ;Returns the # of unlinked,
  1.  ;linkable actions.
  1.  ; Note: Entered in Error (EIE) actions are not linkable,
  1.  ;nor actions taken BEFORE an EIE action.
  1.  ; ARRAYNM - Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM)
  1.  ;           has just been called for given flag title
  1.  ;           and given patient.
  1.  ; LINKBL - optional, passed by ref, returns
  1.  ;          # of linkable actions in array ARRAYNM
  1.  ; UNLINKBL - optional array, passed by ref, returns
  1.  ;    UNLINKBL - # of unlinkable actions in ARRAYNM
  1.  ;    UNLINKBL(ActID)=1, for each unlinkable action,
  1.  ;            where ActID is action subscript in ARRAYNM
  1.  ; ONEIEN - optional, passed by ref, returns
  1.  ;          the action IEN (NOT subscript) if there is
  1.  ;          exactly one available action
  1.  ; AVAIL - Return value of function, returns
  1.  ;         # of unlinked, linkable actions in ARRAYNM
  1.  N ACTID,AVAIL,HASERR,ACTIEN
  1.  S (ACTID,AVAIL,ONEIEN,LINKBL,UNLINKBL)=0
  1.  S HASERR=$$HASERR(ARRAYNM)
  1.  F  S ACTID=$O(@ARRAYNM@("HISTORY",ACTID)) Q:'ACTID  D
  1.  . ; -- Set UNLINKBL whether linked or not:
  1.  . I ACTID=+HASERR S UNLINKBL(ACTID)=1,UNLINKBL=UNLINKBL+1 Q
  1.  . I $G(HASERR),$$ISERR(ARRAYNM,ACTID,$P(HASERR,U,2)) S UNLINKBL(ACTID)=1,UNLINKBL=UNLINKBL+1 Q
  1.  . ; -- If not unlinkable, set LINKBL & check if already linked:
  1.  . S LINKBL=LINKBL+1
  1.  . I $G(@ARRAYNM@("HISTORY",ACTID,"TIUIEN")) Q
  1.  . S AVAIL=AVAIL+1
  1.  . S ACTIEN=+$G(@ARRAYNM@("HISTORY",ACTID,"HISTIEN"))
  1.  I AVAIL=1,$G(ACTIEN)>0 S ONEIEN=ACTIEN
  1.  Q AVAIL
  1.  ;
  1. ISPFTTL(TITLEDA) ; FUNCTION returns 1 if TITLEDA
  1.  ;is PRF Title, otherwise returns 0
  1.  ;Note ISPFTTL is spelled with PF, NOT PRF
  1.  ; Cf RPC ISPRFTTL^TIUPRF2  - spelled with PRF
  1.  N TIUCAT1,TIUCAT2,TIUDADDA
  1.  S TIUDADDA=""
  1.  S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
  1.  S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
  1.  S TIUDADDA=$O(^TIU(8925.1,"AD",TITLEDA,TIUDADDA))
  1.  I TIUDADDA=TIUCAT1!(TIUDADDA=TIUCAT2) Q 1
  1.  Q 0
  1.  ;
  1. ISPFDC(DCLASSDA) ; FUNCTION returns 1 if DCLASSDA
  1.  ;is PRF Document Class, otherwise returns 0
  1.  ; Requires valid IEN in 8925.1
  1.  N TIUCAT1,TIUCAT2
  1.  S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
  1.  S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
  1.  I (DCLASSDA=TIUCAT1)!(DCLASSDA=TIUCAT2) Q 1
  1.  Q 0
  1.  ;
  1. FNDACTIF(TIUDA) ;Find Action Info for Note TIUDA
  1.  ;Returns AssignIEN^ActionIEN^ActionNumber or
  1.  ;0^"error message" if not linked, where
  1.  ; Action IEN is Assignment History IEN and
  1.  ; Action ID is node from GETHTIU^DGPFAPI1 array
  1.  ; Note: for Action IEN ONLY, use $$GETLINK^DGPFAPI1(TIUDA)
  1.  N ACTID,TIUTTL,TIURET,DFN
  1.  S ACTID=0,TIURET=0
  1.  S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2)
  1.  S TIUTTL=+$G(^TIU(8925,TIUDA,0))
  1.  S TIURET=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,"^TMP(""TIUPRF"",$J)")
  1.  I '+TIURET Q TIURET
  1.  F  S ACTID=$O(^TMP("TIUPRF",$J,"HISTORY",ACTID)) Q:'ACTID  D
  1.  . I +$G(^TMP("TIUPRF",$J,"HISTORY",ACTID,"TIUIEN"))=TIUDA D
  1.  . . S TIURET=+^TMP("TIUPRF",$J,"ASSIGNIEN")_U_+^TMP("TIUPRF",$J,"HISTORY",ACTID,"HISTIEN")_U_ACTID
  1.  K ^TMP("TIUPRF",$J)
  1.  Q TIURET
  1.  ;
  1. FNDFLAG(TIUTITLE) ; Find Associated Flag IEN for Title
  1.  ;Function returns VarPTRFlagIEN^FlagName or
  1.  ;0^msg
  1.  ;from Flag file 26.15 (National) or 26.11 (Local)
  1.  ;Example: 1;DGPF(26.15,^BEHAVIORAL]
  1.  I '$L($T(FNDTITLE^DGPFAPI1)) Q "?"
  1.  Q $$FNDTITLE^DGPFAPI1(TIUTITLE)
  1.  ;
  1. CFLDFLAG(TIUTITLE) ; Code for computed field PRFFLAG in file 8925.1
  1.  ; Returns FlagName from file 26.11 or 26.15 for flag associated
  1.  ;with TIUTITLE
  1.  ; Returns ? if no flag is assoc w/ title or flag cannot be found
  1.  ; Returns NA if TIUTITLE is not a PRF title
  1.  ; Requires TITTITLE = 8925.1 IEN
  1.  N FLAGINFO
  1.  I '$$ISPFTTL(TIUTITLE) Q "NA"
  1.  S FLAGINFO=$$FNDFLAG(TIUTITLE)
  1.  I 'FLAGINFO Q "?"
  1.  Q $P(FLAGINFO,U,2)
  1.  ;
  1. CFLDACT(NOTEDA) ; Code for computed field PRF FLAG ACTION in file 8925
  1.  ; Returns: Date of Linked Action[space]Name of Action
  1.  ;for action NOTEDA is linked to.
  1.  N TIUTTL,LINE,TIULINK,DFN,ACTINFO,TIUDG,ACTID,ACTDATE,ACTNAME,TIUNODE0
  1.  S TIUNODE0=^TIU(8925,NOTEDA,0),TIUTTL=$P(TIUNODE0,U)
  1.  S TIULINK=$$GETLINK^DGPFAPI1(NOTEDA)
  1.  I 'TIULINK,'$$ISPFTTL(TIUTTL) Q "NA"
  1.  I 'TIULINK Q "?"
  1.  S DFN=$P(TIUNODE0,U,2)
  1.  S ACTINFO=$$FNDACTIF^TIUPRFL(NOTEDA)
  1.  S ACTID=+$P(ACTINFO,U,3)
  1.  ; -- If not PRF note but has link by mistake, return ? instead of NA:
  1.  I 'ACTID Q "?" ; Title not linked to flag
  1.  S TIUDG=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,"^TMP(""TIUPRF"",$J)")
  1.  S ACTDATE=$P(^TMP("TIUPRF",$J,"HISTORY",ACTID,"DATETIME"),U)
  1.  S ACTDATE=$$FMTE^XLFDT(ACTDATE,"2D")
  1.  S ACTNAME=$P(^TMP("TIUPRF",$J,"HISTORY",ACTID,"ACTION"),U,2)
  1.  S LINE=ACTDATE_" "_ACTNAME
  1.  K ^TMP("TIUPRF",$J)
  1.  Q LINE
  1.  ;
  1. ISERR(ARRAYNM,ACTID,REACTDTM) ; Is Flag Action erroneous?
  1.  ; Actions that take place BEFORE an EIE action are ERRONEOUS
  1.  ;An EIE action itself is NOT erroneous
  1.  ; Should be called AFTER HASERR, & only if HASERR>0
  1.  ; Returns: 1 if Action date/time of ACTID is strictly BEFORE
  1.  ;            the Entered in Error date/time
  1.  ;          0 if = or AFTER the Entered in Error date/time
  1.  ;         -1^msg if error
  1.  ; Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM) has just been
  1.  ;called, and array named ARRAYNM currently exists for title
  1.  ;assoc w/ flag and for given patient.
  1.  ;Requires ARRAYNM
  1.  ;Requires ACTID - subscript preceding "ACTION" in above array
  1.  ;Requires REACTDTM as set in HASERR.
  1.  N ISERR,ACTDTM S ISERR=0
  1.  S ACTDTM=$P($G(@ARRAYNM@("HISTORY",ACTID,"DATETIME")),U)
  1.  I ACTDTM'>0 S ISERR="-1^Can't tell whether action is erroneous" G ISERRX
  1.  I $G(REACTDTM)'>0 S ISERR="-1^Can't tell whether action is erroneous" G ISERRX
  1.  I ACTDTM<REACTDTM S ISERR=1
  1. ISERRX Q ISERR
  1.  ;
  1. HASERR(ARRAYNM) ; Function indicates that given flag assignmt
  1.  ;for given patient has ERRONEOUS actions.
  1.  ; ERRONEOUS ACTIONS: all actions taken BEFORE
  1.  ;an ENTERED IN ERROR (EIE) action
  1.  ; Note: HASERR is equivalent to Has an EIE Action (HASEIE):
  1.  ;(HASERR implies HASEIE. and HASEIE implies HASERR since
  1.  ;EIE action always has actions taken previously.)
  1.  ; Returns: EIEActionID^EIEDateTime if flag assignmt has been
  1.  ;            marked Entered in Error (EIE).  If there are multiple
  1.  ;            EIE actions, returns the most RECENT.
  1.  ;          0 if assignmt not marked EIE
  1.  ;         -1^msg if error
  1.  ; Actions and notes for Erroneous actions or EIE actions
  1.  ;should not be displayed in OR/TIU flag-related displays.
  1.  ; Requires that $$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM) has just been
  1.  ;called, and array named ARRAYNM currently exists for title
  1.  ;assoc w/ flag and for given patient.
  1.  N ACTID,HASERR
  1.  I '$D(@ARRAYNM@("HISTORY")) S HASERR="-1^Can't tell whether flag assignment has erroneous actions" G HASERRX
  1.  S ACTID=1000000,HASERR=0
  1.  F  S ACTID=$O(@ARRAYNM@("HISTORY",ACTID),-1) G:'+ACTID HASERRX D  G:HASERR HASERRX
  1.  . I $P(@ARRAYNM@("HISTORY",ACTID,"ACTION"),U,2)="ENTERED IN ERROR" D
  1.  . . S HASERR=ACTID_U_$P(@ARRAYNM@("HISTORY",ACTID,"DATETIME"),U)
  1. HASERRX Q HASERR