TIUPRF2 ; SLC/JMH - RPCs for Patient Record Flags ; 11/3/05
;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
;
; $$GETACT^DGPFAPI: IA# 3860
; $$GETHTIU^DGPFAPI1: IA# 4383
; $$STOTIU^DGPFAPI2: IA# 4384
;
GETTITLE(TIUY,PTDFN,FLAGID) ; RPC Gets Note Title associated with FLAGID for PTDFN
;Receives TIUY by ref; passes back
; TIUY = TitleIEN^Title
; 0 if no title is associated or flg assignmt is not active
;Requires PTDFN
;Requires FLAGID - identifier for particular flag assignment
; for patient PTDFN. Set as subscript in GETACT^DGPFAPI.
; See GETFLG^ORPRF.
N PRFARR K TIUY S TIUY=0
Q:'$G(PTDFN) Q:'$G(FLAGID)
S TIUY=$$GETACT^DGPFAPI(PTDFN,"PRFARR") ;Get ACTive flag info
Q:'TIUY
S TIUY=$G(PRFARR(FLAGID,"TIUTITLE"))
I TIUY'>0 S TIUY=0
Q
;
GETNOTES(TIUY,PTDFN,TIUTTL,REVERSE) ; RPC gets SIGNED, LINKED PRF
;notes titled TIUTTL for patient PTDFN
; Excludes Notes linked to Entered in Error (EIE) actions and
;notes linked to Erroneous actions (actions taken prior to
;EIE actions).
; Receives TIUY by ref; passes back
; TIUY = # of notes
; TIUY([Reverse][Incremented]InternalNoteDate) =
; NoteIEN^ActionName^ExternalNoteDate^AuthorName
; Requires PTDFN,TIUTTL
; Includes status Uncosigned, Completed, & Amended only.
; Optional REVERSE - Boolean Flag:
; 1 - Sort notes by reverse chronological order
; 0 (default) - Sort notes by chronological order
N TIUDG,ACTID,TIUIDATE,TIUEDATE,TIUIEN,TIUACT,STATUS
N TIUAUTH,DTARRAY,HASERR,ARRAYNM
K TIUY ; Initialize array in case caller hasn't done so.
S (TIUY,ACTID)=0
; -- Get Assgn Hist info (GETHTIU initializes array
; so we don't need to):
S ARRAYNM="^TMP(""TIUPRFH"",$J)"
S TIUDG=$$GETHTIU^DGPFAPI1(PTDFN,TIUTTL,ARRAYNM)
G:'TIUDG GETNOTEX
S HASERR=$$HASERR^TIUPRFL(ARRAYNM)
F S ACTID=$O(@ARRAYNM@("HISTORY",ACTID)) Q:'ACTID D
. I ACTID=+HASERR Q ;Entered in Error
. I HASERR>0,$$ISERR^TIUPRFL(ARRAYNM,ACTID,$P(HASERR,U,2)) Q ;erroneous
. S TIUIEN=+@ARRAYNM@("HISTORY",ACTID,"TIUIEN")
. Q:TIUIEN'>0 ;TMP node may be just ^
. ; -- Include only complete or amended or uncosigned notes:
. S STATUS=$P($G(^TIU(8925,TIUIEN,0)),U,5) I '((STATUS=6)!(STATUS=7)!(STATUS=8)) Q
. S TIUACT=$P(@ARRAYNM@("HISTORY",ACTID,"ACTION"),U,2)
. N TIUFLDS,TIUERR D GETS^DIQ(8925,TIUIEN_",","1202;1301","IE","TIUFLDS","TIUERR")
. S TIUIDATE=TIUFLDS(8925,TIUIEN_",",1301,"I")
. ; -- Increment date if there are multiple notes w/ same exact date:
. F S:$D(DTARRAY(TIUIDATE)) TIUIDATE=TIUIDATE+.0000001 I '$D(DTARRAY(TIUIDATE)) S DTARRAY(TIUIDATE)="" Q
. I $G(REVERSE) S TIUIDATE=9999999-TIUIDATE
. S TIUEDATE=$E(TIUFLDS(8925,TIUIEN_",",1301,"E"),1,18)
. I TIUEDATE="" S TIUEDATE="No Ref Date"
. S TIUAUTH=TIUFLDS(8925,TIUIEN_",",1202,"E")
. I TIUAUTH="" S TIUAUTH="No Author"
. S TIUY=TIUY+1
. S TIUY(TIUIDATE)=TIUIEN_U_TIUACT_U_TIUEDATE_U_TIUAUTH
GETNOTEX ;
K ^TMP("TIUPRFH",$J)
Q
;
GETACTS(TIUY,TIUTTL,DFN) ;RPC Gets PRF Action info
;"Action" is shorthand for Assignment History entry
;Returns data in the following format for each Action:
;TIUY(ACTID) =
; FLAGNAME^ASSGNIEN^ACTIONNAME^ACTIONIEN^ACTIONDATEI^ACTIONDATEE^TIUIEN
; where Integer ACTID = subscript after "HISTORY" in array returned
; by GETHTIU^DGPFAPI1
;Returns linkable actions (whether linked or not) for Patient DFN
; and flag assoc w/ TIUTTL.
;Excludes UNLINKABLE actions = Entered in Error actions (EIE) or
; actions taken prior to an EIE action.
;Erroneous and EIE actions may be for the wrong patient, etc.
N TIUDG,ACTID,TIUFLAG,UNLINKBL,ARRAYNM
S TIUY=1,ARRAYNM="^TMP(""TIUPRFH"",$J)"
S TIUDG=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM)
I 'TIUDG S TIUY="0^"_$P(TIUDG,U,2) G GETACTX
; -- If no unlinked, linkable actions exist, say so but go on:
I '$$AVAILACT^TIUPRFL("^TMP(""TIUPRFH"",$J)",,.UNLINKBL) S TIUY="0^All linkable Flag actions are already linked"
; -- Return ALL linkable actions (linked or not):
S TIUFLAG=$P(^TMP("TIUPRFH",$J,"FLAG"),U,2)_U_$P(^TMP("TIUPRFH",$J,"ASSIGNIEN"),U)
S ACTID=0
F S ACTID=$O(^TMP("TIUPRFH",$J,"HISTORY",ACTID)) Q:'+ACTID D
. Q:$G(UNLINKBL(ACTID))
. S TIUY(ACTID)=TIUFLAG
. S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"ACTION"),U,2)
. S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"HISTIEN"),U,1)
. S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"DATETIME"),U,1)
. S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"DATETIME"),U,2)
. S TIUY(ACTID)=TIUY(ACTID)_U_$P(^TMP("TIUPRFH",$J,"HISTORY",ACTID,"TIUIEN"),U,1)
GETACTX ;
K ^TMP("TIUPRFH",$J)
Q
;
LINK(TIUY,TIUIEN,ASSGNDA,ACTIEN,DFN) ;RPC Link TIU Doc TIUIEN to
; the PRF action
N TIUTTL
S TIUTTL=+$G(^TIU(8925,TIUIEN,0))
I 'TIUTTL S TIUY="0^Document does not exist" Q
; Remove any links before making new link
D UNLINK^TIUPRF1(TIUIEN)
S TIUY=$$STOTIU^DGPFAPI2(DFN,ASSGNDA,ACTIEN,TIUIEN)
Q
GETSTAT(TIUY,TIUIEN) ;RPC Gets the status of TIU Doc TIUIEN
;Returns STATIEN^STATNAME
N TIUTTL
S TIUTTL=+$G(^TIU(8925,TIUIEN,0))
I 'TIUTTL S TIUY="0^Document does not exist" Q
S TIUY=$P(^TIU(8925,TIUIEN,0),U,5)
S TIUY=TIUY_U_$P($G(^TIU(8925.6,TIUY,0)),U,1)
Q
ISPRFTTL(TIUY,TIUDA) ;RPC Takes as input 8925.1 IEN
; and checks if it is a PRF title
; Cf ISPFTTL^TIUPRFL. which is a FUNCTION
N TIUCAT1,TIUCAT2,TIUD1
S TIUY=0,TIUD1=""
S TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
S TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
S TIUD1=$O(^TIU(8925.1,"AD",TIUDA,TIUD1))
I TIUD1=TIUCAT1!(TIUD1=TIUCAT2) S TIUY=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRF2 5680 printed Apr 09, 2024@21:47:14 Page 2
TIUPRF2 ; SLC/JMH - RPCs for Patient Record Flags ; 11/3/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
+2 ;
+3 ; $$GETACT^DGPFAPI: IA# 3860
+4 ; $$GETHTIU^DGPFAPI1: IA# 4383
+5 ; $$STOTIU^DGPFAPI2: IA# 4384
+6 ;
GETTITLE(TIUY,PTDFN,FLAGID) ; RPC Gets Note Title associated with FLAGID for PTDFN
+1 ;Receives TIUY by ref; passes back
+2 ; TIUY = TitleIEN^Title
+3 ; 0 if no title is associated or flg assignmt is not active
+4 ;Requires PTDFN
+5 ;Requires FLAGID - identifier for particular flag assignment
+6 ; for patient PTDFN. Set as subscript in GETACT^DGPFAPI.
+7 ; See GETFLG^ORPRF.
+8 NEW PRFARR
KILL TIUY
SET TIUY=0
+9 if '$GET(PTDFN)
QUIT
if '$GET(FLAGID)
QUIT
+10 ;Get ACTive flag info
SET TIUY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")
+11 if 'TIUY
QUIT
+12 SET TIUY=$GET(PRFARR(FLAGID,"TIUTITLE"))
+13 IF TIUY'>0
SET TIUY=0
+14 QUIT
+15 ;
GETNOTES(TIUY,PTDFN,TIUTTL,REVERSE) ; RPC gets SIGNED, LINKED PRF
+1 ;notes titled TIUTTL for patient PTDFN
+2 ; Excludes Notes linked to Entered in Error (EIE) actions and
+3 ;notes linked to Erroneous actions (actions taken prior to
+4 ;EIE actions).
+5 ; Receives TIUY by ref; passes back
+6 ; TIUY = # of notes
+7 ; TIUY([Reverse][Incremented]InternalNoteDate) =
+8 ; NoteIEN^ActionName^ExternalNoteDate^AuthorName
+9 ; Requires PTDFN,TIUTTL
+10 ; Includes status Uncosigned, Completed, & Amended only.
+11 ; Optional REVERSE - Boolean Flag:
+12 ; 1 - Sort notes by reverse chronological order
+13 ; 0 (default) - Sort notes by chronological order
+14 NEW TIUDG,ACTID,TIUIDATE,TIUEDATE,TIUIEN,TIUACT,STATUS
+15 NEW TIUAUTH,DTARRAY,HASERR,ARRAYNM
+16 ; Initialize array in case caller hasn't done so.
KILL TIUY
+17 SET (TIUY,ACTID)=0
+18 ; -- Get Assgn Hist info (GETHTIU initializes array
+19 ; so we don't need to):
+20 SET ARRAYNM="^TMP(""TIUPRFH"",$J)"
+21 SET TIUDG=$$GETHTIU^DGPFAPI1(PTDFN,TIUTTL,ARRAYNM)
+22 if 'TIUDG
GOTO GETNOTEX
+23 SET HASERR=$$HASERR^TIUPRFL(ARRAYNM)
+24 FOR
SET ACTID=$ORDER(@ARRAYNM@("HISTORY",ACTID))
if 'ACTID
QUIT
Begin DoDot:1
+25 ;Entered in Error
IF ACTID=+HASERR
QUIT
+26 ;erroneous
IF HASERR>0
IF $$ISERR^TIUPRFL(ARRAYNM,ACTID,$PIECE(HASERR,U,2))
QUIT
+27 SET TIUIEN=+@ARRAYNM@("HISTORY",ACTID,"TIUIEN")
+28 ;TMP node may be just ^
if TIUIEN'>0
QUIT
+29 ; -- Include only complete or amended or uncosigned notes:
+30 SET STATUS=$PIECE($GET(^TIU(8925,TIUIEN,0)),U,5)
IF '((STATUS=6)!(STATUS=7)!(STATUS=8))
QUIT
+31 SET TIUACT=$PIECE(@ARRAYNM@("HISTORY",ACTID,"ACTION"),U,2)
+32 NEW TIUFLDS,TIUERR
DO GETS^DIQ(8925,TIUIEN_",","1202;1301","IE","TIUFLDS","TIUERR")
+33 SET TIUIDATE=TIUFLDS(8925,TIUIEN_",",1301,"I")
+34 ; -- Increment date if there are multiple notes w/ same exact date:
+35 FOR
if $DATA(DTARRAY(TIUIDATE))
SET TIUIDATE=TIUIDATE+.0000001
IF '$DATA(DTARRAY(TIUIDATE))
SET DTARRAY(TIUIDATE)=""
QUIT
+36 IF $GET(REVERSE)
SET TIUIDATE=9999999-TIUIDATE
+37 SET TIUEDATE=$EXTRACT(TIUFLDS(8925,TIUIEN_",",1301,"E"),1,18)
+38 IF TIUEDATE=""
SET TIUEDATE="No Ref Date"
+39 SET TIUAUTH=TIUFLDS(8925,TIUIEN_",",1202,"E")
+40 IF TIUAUTH=""
SET TIUAUTH="No Author"
+41 SET TIUY=TIUY+1
+42 SET TIUY(TIUIDATE)=TIUIEN_U_TIUACT_U_TIUEDATE_U_TIUAUTH
End DoDot:1
GETNOTEX ;
+1 KILL ^TMP("TIUPRFH",$JOB)
+2 QUIT
+3 ;
GETACTS(TIUY,TIUTTL,DFN) ;RPC Gets PRF Action info
+1 ;"Action" is shorthand for Assignment History entry
+2 ;Returns data in the following format for each Action:
+3 ;TIUY(ACTID) =
+4 ; FLAGNAME^ASSGNIEN^ACTIONNAME^ACTIONIEN^ACTIONDATEI^ACTIONDATEE^TIUIEN
+5 ; where Integer ACTID = subscript after "HISTORY" in array returned
+6 ; by GETHTIU^DGPFAPI1
+7 ;Returns linkable actions (whether linked or not) for Patient DFN
+8 ; and flag assoc w/ TIUTTL.
+9 ;Excludes UNLINKABLE actions = Entered in Error actions (EIE) or
+10 ; actions taken prior to an EIE action.
+11 ;Erroneous and EIE actions may be for the wrong patient, etc.
+12 NEW TIUDG,ACTID,TIUFLAG,UNLINKBL,ARRAYNM
+13 SET TIUY=1
SET ARRAYNM="^TMP(""TIUPRFH"",$J)"
+14 SET TIUDG=$$GETHTIU^DGPFAPI1(DFN,TIUTTL,ARRAYNM)
+15 IF 'TIUDG
SET TIUY="0^"_$PIECE(TIUDG,U,2)
GOTO GETACTX
+16 ; -- If no unlinked, linkable actions exist, say so but go on:
+17 IF '$$AVAILACT^TIUPRFL("^TMP(""TIUPRFH"",$J)",,.UNLINKBL)
SET TIUY="0^All linkable Flag actions are already linked"
+18 ; -- Return ALL linkable actions (linked or not):
+19 SET TIUFLAG=$PIECE(^TMP("TIUPRFH",$JOB,"FLAG"),U,2)_U_$PIECE(^TMP("TIUPRFH",$JOB,"ASSIGNIEN"),U)
+20 SET ACTID=0
+21 FOR
SET ACTID=$ORDER(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID))
if '+ACTID
QUIT
Begin DoDot:1
+22 if $GET(UNLINKBL(ACTID))
QUIT
+23 SET TIUY(ACTID)=TIUFLAG
+24 SET TIUY(ACTID)=TIUY(ACTID)_U_$PIECE(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID,"ACTION"),U,2)
+25 SET TIUY(ACTID)=TIUY(ACTID)_U_$PIECE(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID,"HISTIEN"),U,1)
+26 SET TIUY(ACTID)=TIUY(ACTID)_U_$PIECE(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID,"DATETIME"),U,1)
+27 SET TIUY(ACTID)=TIUY(ACTID)_U_$PIECE(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID,"DATETIME"),U,2)
+28 SET TIUY(ACTID)=TIUY(ACTID)_U_$PIECE(^TMP("TIUPRFH",$JOB,"HISTORY",ACTID,"TIUIEN"),U,1)
End DoDot:1
GETACTX ;
+1 KILL ^TMP("TIUPRFH",$JOB)
+2 QUIT
+3 ;
LINK(TIUY,TIUIEN,ASSGNDA,ACTIEN,DFN) ;RPC Link TIU Doc TIUIEN to
+1 ; the PRF action
+2 NEW TIUTTL
+3 SET TIUTTL=+$GET(^TIU(8925,TIUIEN,0))
+4 IF 'TIUTTL
SET TIUY="0^Document does not exist"
QUIT
+5 ; Remove any links before making new link
+6 DO UNLINK^TIUPRF1(TIUIEN)
+7 SET TIUY=$$STOTIU^DGPFAPI2(DFN,ASSGNDA,ACTIEN,TIUIEN)
+8 QUIT
GETSTAT(TIUY,TIUIEN) ;RPC Gets the status of TIU Doc TIUIEN
+1 ;Returns STATIEN^STATNAME
+2 NEW TIUTTL
+3 SET TIUTTL=+$GET(^TIU(8925,TIUIEN,0))
+4 IF 'TIUTTL
SET TIUY="0^Document does not exist"
QUIT
+5 SET TIUY=$PIECE(^TIU(8925,TIUIEN,0),U,5)
+6 SET TIUY=TIUY_U_$PIECE($GET(^TIU(8925.6,TIUY,0)),U,1)
+7 QUIT
ISPRFTTL(TIUY,TIUDA) ;RPC Takes as input 8925.1 IEN
+1 ; and checks if it is a PRF title
+2 ; Cf ISPFTTL^TIUPRFL. which is a FUNCTION
+3 NEW TIUCAT1,TIUCAT2,TIUD1
+4 SET TIUY=0
SET TIUD1=""
+5 SET TIUCAT1=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT I","DC")
+6 SET TIUCAT2=+$$DDEFIEN^TIUFLF7("PATIENT RECORD FLAG CAT II","DC")
+7 SET TIUD1=$ORDER(^TIU(8925.1,"AD",TIUDA,TIUD1))
+8 IF TIUD1=TIUCAT1!(TIUD1=TIUCAT2)
SET TIUY=1
+9 QUIT
