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