Routine: TIUPRF2

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

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)

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)

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)

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)

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

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

TIUPRF2.m